Verknüpfung per Makro Ändern

Hallo zusammen!
Ich habe eine Idee, weiß aber nicht wie ich sie in Excel umsetzen soll
Ausgangssituation:
Ich habe eine Quelldatei die irgendwo auf dem Rechner liegt. Außerdem eine Auswertungsdatei, die mit der Quelldatei verknüpft ist. In der Auswertungsdatei will ich ein Makro starten, welches den Dateiexplorer öffnet und ich die Quelldatei auswählen kann. Nun sollen die vorhanden Verknüpfungen des Bereiches c6:y16 auf diesen neuen Pfad aktualisiert werden.
Der Aufbau der Tabelle in der Quelldatei und in der Auswertungsdatei bleibt immer unverändert (keine neuen Zeilen oder spalten). Lediglich der Ort und der Name der Quelldatei ändern sich.
Beispiel an einer Zelle:
Vorher ='G:\Sammlung\abcsd.xlsm]Analyse 2'!$F$4
Nacher ='G:\Projekt\dcdf.xlsm]Analyse 2'!$F$4
wie kann ich das per makro programmieren?
für eure Hilfe bedanke ich mich schonmal im voraus!!!!
Quasi folgendes Makro nur halt für bestimmte Zellen.
Hier steckt ja leider der Befehl thisworkbook drin..

Sub Change_Link()
Dim myLinks As Variant
Dim NewSource As String
Dim OldSource As String
Dim i As Integer
If MsgBox("Neues Projekt anlegen?", vbYesNo + vbQuestion) = vbNo Then
MsgBox "Abbruch"
Exit Sub
End If
myLinks = ThisWorkbook.LinkSources
For i = 1 To UBound(myLinks)
OldSource = CStr(myLinks(i))
NewSource = Application.GetOpenFilename()
ThisWorkbook.ChangeLink Name:=OldSource, Newname:=NewSource
Next
' ThisWorkbook.UpdateLink
End Sub

Du kannst ja prüfen, ob in den Formeln der abgefragte Link überhaupt noch vorhanden ist bevor du nach der Datei fragst, mit der er ersetzt werden soll:
ausserdem ist jetzt noch eingebaut, dass du das Ersetzen abbrechen kannst, wenn du für den Link keine neue Datei haben willst:


Sub Change_Link_Zellbereich()
Dim myLinks As Variant
Dim NewSource As String
Dim OldSource As String
Dim i As Integer
Dim x As Long
Dim Check As Range
If MsgBox("Neues Projekt anlegen?", vbYesNo + vbQuestion) = vbNo Then
MsgBox "Abbruch"
Exit Sub
End If
myLinks = ThisWorkbook.LinkSources
For i = 1 To UBound(myLinks)
OldSource = CStr(myLinks(i))
x = InStrRev(OldSource, "\")
OldSource = Left(OldSource, x) & "[" & Mid(OldSource, x + 1) & "]"
Set Check = ThisWorkbook.Sheets("Tabelle1").Range("C6:Y16").Find(what:=OldSource, looktat:= _
xlPart, LookIn:=xlFormulas)
If Not Check Is Nothing Then
NewSource = Application.GetOpenFilename(Title:="Ersetze " & Mid(OldSource, x + 1) & "  _
durch: ")
If LCase(NewSource) Like "*.xls?" Then
x = InStrRev(NewSource, "\")
NewSource = Left(NewSource, x) & "[" & Mid(NewSource, x + 1) & "]"
ThisWorkbook.Sheets("Tabelle1").Range("C6:Y16").Replace OldSource, NewSource,  _
xlPart
End If
End If
Next
End Sub

Gruß Daniel

Forumthread: Verknüpfung per Makro Ändern

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Infobox / Tutorial