Formelpfade per VBA anpassen

Hallo Leute,
ich benötige mal wieder euren grauen Zellen.
Ich habe den Ordner "Training" in welchem sich (eine Ebene tiefer) weitere Unterordner befinden.
In diesen Unterordnern befinden sich Exceldateien, die miteinander Formelverknüpft sind.
Der gesamte Ordner "Training" mit all seinen Unterordnern und darin befindlichen Dateien benötigen keine Daten von außerhalb - der Ordner "Training" ist so zu sagen autark.
Dachte ich damals: Ich kann dieses geschlossene System überall hinlegen - Irrtum!
Bsp.: vorher: C:/Abteilung_C/Training/...
nachher: C:/Abteilung_C/Unterabteilung_1/Training/...
ihr wisst was ich meine... die Formeln reagierten nicht mit einer Anpassung.
Also musste ich aktiv werden und über Bearbeiten Ersetzen von Hand anpassen.
Das ist viel Arbeit und - da ich nicht der einzige Nutzer bin - KW kenne nur ich und in Excel sind manche Mitarbeiter auch nicht sooo begabt, sodaß sie diesen Prozess vollziehen könnten / wollten. Entschuldigung - lange Rede (war aber nötig).
Die Idee:
Ich habe Bearbeiten Ersetzen per Rekorder aufgezeichnet und diesen Codeschnipsel in mein Workbook open eingefügt.
Private Sub Workbook_open()
Dim strPath As String, strSearch As String
strSearch = "Training"
strPath = ThisWorkbook.Path
strPath = Left(strPath, InStr(1, strPath, strSearch) + Len(strSearch))
On Error GoTo Err
For Each Sheet In ThisWorkbook.Sheets
Sheet.Visible = True
Sheet.Unprotect "KW"
ChDir strPath & "\Basisdaten"
ActiveWorkbook.ChangeLink Name:="AktuellerWorkbook.Path" &"\Training\Basisdaten\Basis.xls", _
NewName:=strPath & "\Basisdaten\Basis.xls", Type:=xlExcelLinks
Sheet.Protect "KW"
Next
...
in Worten ausgedrückt:
bei jedem öffnen einer Einzeldatei die Verknüpfungen enthält vorher per vba alle sheets anzeigen, entsperren, Quelldatei suchen und so die "alten" Formelpfade ersetzen. Im Code oben: "AktuellerWorkbook.Path" irgendwie ersetzen durch einen richtigen Codeteil.
Oder so: Einzeldatei wird geöffnet und egal, wo "Training" liegt, geh zur Verknüpfung nur 1 Ebene höher (dann bist du in "Training") und dann eine Ebene tiefer in einen anderen Ordner wo sich die Quelldatei befindet.
ich hoffe ihr versteht mein Kauderwelsch...
Hat jemand eine Ahnung wie man das realisieren kann oder gar eine bessere Idee für mein Problem?
Danke für jede Hilfe
Gruß
Alex

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Alex,
mit den nachfolgenden Anpassungen / Ergänzungen sollte die Anpassung der Links funktionieren.
Die MsgBox-Zeilen, die ich als Testzeile eingebaut hab, kannst du weglassen. Sie dienen nur als Prüfanzeige, ob das Makro jeweils korrekt weiter arbeitet.
Vermeide bei der Erstellung von VBA-Prozeduren die Verwendung von Variablennamen oder Sprungaddressen-Bezeichnungen, die identisch sind mit VBA-Funktionen/-Methoden, hier z.B. Err in
On Error goto Err
Wenn man schon Variablen deklariert, dann doch bitte alle verwendeten Variablen deklarieren. Bei dir war "Sheet" nicht als Objekt oder Variant deklariert.
Aktiviere im VBA-Editor unter Extras--Optionen... im Reiter "Editor" die Option "Variablendeklaration erforderlich".
In Zukunft fügt Excel dann automatisch in allen Modulen die Zeile "Option Explicit" als 1. Zeile ein und meldet beim Kompilieren fehlende Variablendeklaration. Außerdem erkennt man so leichter Schreibfehler bei Variablen. Wenn Variablen als entsprechende Objekte deklariert werden (z.B. Worksheet, Range, etc.) dann erleichtert man sich die Programmierung, wenn die Option "Elemente automatisch auflisten" aktiv ist.
Gruß
Franz

Private Sub Workbook_open()
Dim strPath As String, strSearch As String
Dim bolVorhanden As Boolean, varLinks As Variant, varOldLink As Variant, strNewLink As String
Dim objSheet As Object
On Error GoTo Fehler
strSearch = "Training"
strPath = ThisWorkbook.Path
strPath = Left(strPath, InStr(1, strPath, strSearch) + Len(strSearch))
strNewLink = strPath & "\Basisdaten\Basis.xls"
'vorhanden Verknüpfungen durchsuchen
varLinks = ThisWorkbook.LinkSources(Type:=xlExcelLinks)
If IsEmpty(varLinks) Then
MsgBox "Keine Formelverknüpfungen in andere Dateien vorhanden" 'Testzeile
GoTo Fehler
End If
For Each varOldLink In varLinks
If InStr(1, LCase(varOldLink), LCase("\Training\Basisdaten\Basis.xls")) > 0 Then
bolVorhanden = True
Exit For
End If
Next
If bolVorhanden = True Then
If LCase(strNewLink)  LCase(varOldLink) Then
For Each objSheet In ThisWorkbook.Sheets
objSheet.Visible = True 'Warum sichtbar machen?
objSheet.Unprotect "KW"
Next
ActiveWorkbook.ChangeLink Name:=varOldLink, NewName:=strNewLink, Type:=xlExcelLinks
Me.UpdateLink Name:=strNewLink, Type:=xlExcelLinks
For Each objSheet In ThisWorkbook.Sheets
objSheet.Protect "KW"
Next
MsgBox "Formelverknüpfung wurde aktualisiert." 'Testzeile
Else
MsgBox "Formelverknüpfung ist korrekt, keine Aktualisierung erforderlich." 'Testzeile
End If
Else
MsgBox "Kein Link zu verknüpfter Datei " _
& """...\Training\Basisdaten\Basis.xls"" gefunden"
End If
'Fehlerbehandlung
Fehler:
With Err
Select Case .Number
Case 0 'alles OK
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
End Sub

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Formelpfade per VBA anpassen

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread