Verknüpfungen in VBA unterdrücken
30.11.2004 14:26:24
Bastian
ich habe vor einiger Zeit einen Code zum Einlesen von Tabellenblätter aus externen Dateien von Euch bekommen. Funktioniert auch prima. Inzwischen sind die einzulesenden Tabellenblätter ziemlich viele und da diese wieder mit anderen Tabellenblättern verknüpft sind, muss bei jedem Einlesevorgang bestätigt werden, ob die Verknüpfung der externen Tabellen aktualisiert werden soll oder nicht. Das ist schon sehr lästig. Dabei ist es nicht wichtig ob die Verknüpfungen der externen Dateien zu ihren externen Dateien vor dem Einlesen aktualisiert werden oder nicht. Ich würde diese Aufforderung gerne entweder vollkommen unterdrücken, grundsätzliche bejahen oder besser verneinen, jedenfalls nicht dauernd zu einer Eingabe gezwungen werden; nur weiß ich nicht wie dies in den Code einzubauen wäre. Es gibt zwar ähnliches in der Recherche aber ich kriege es nicht mit meinem Code zusammen.
Der Code sieht bisher folgendermaßen aus:
Dim WS As Worksheet
Const copyrange As String = "A1:M47"
'Startprozedur
Sub start_copy_pgm()
Const VerzDefault As Variant = "G:\DAT\NL-HH\Auslastung\Auslastungsmeldung"
Dim verz As String
Set WS = ActiveWorkbook.ActiveSheet
verz = Ordner_def(VerzDefault)
ChDir verz
Application.ScreenUpdating = False
ShowFileList (verz)
End Sub
'Excel-Dateien öffnen
Sub ShowFileList(folderspec)
Dim exapp As Object
Dim fs, f, fc, fl As Object
Dim quellbereich As Range
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
For Each fl In fc
If fl.Type = "Microsoft Excel-Arbeitsblatt" Then
Set exapp = GetObject(folderspec & "\" & fl.Name)
Set quellbereich = exapp.Sheets(2).Range(copyrange)
Call kopieren(quellbereich)
Call schliessen(fl.Name)
End If
Next
End Sub
'Kopierprozedur
Sub kopieren(quelle)
' Schutz aufheben:
ActiveSheet.Unprotect
Dim zielbereich As Range
Dim r As Integer
r = WS.UsedRange.Rows.Count + 2
Set zielbereich = WS.Range("A" & r)
quelle.Copy zielbereich
' Schutz aktivieren
' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
' Scenarios:=True
End Sub
'Schließprozedur
Sub schliessen(wind)
Windows(wind).Visible = True
Application.DisplayAlerts = False
Workbooks(wind).Close
End Sub
'Ordnerdefinition
'aus Herber-Forum von K.Rola am 11.10.04
Function Ordner_def(defaultwert As Variant) As String
Dim objFolderItem As Object, strPath As String, objShell As Object
Dim objFolder As Object
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0&, "Ordner auswählen...", 0&, defaultwert)
If objFolder Is Nothing Then End
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
Ordner_def = strPath
End Function
Der Code ist leider etwas umfangreich, aber vielleicht schaut ja doch mal einer drauf und kann mir freundlicher Weise Rat und Hilfeleistung bringen?
Gruß, Bastian