Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1484to1488
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Verknüpfung per Makro Ändern

Verknüpfung per Makro Ändern
12.04.2016 14:01:17
Daniel
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

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Verknüpfung per Makro Ändern
12.04.2016 14:14:44
Daniel
Hi
die ChangeLink-Funktion ändert die Quelle für alle betroffenen Formeln in der Datei.
wenn du die Bezüge auf die neue Datei nur in einem bestimmten Zellbereich ändern willst und in den andren Zellbereichen die Bezüge auf die alte Datei erhalten bleiben sollen, müsstest du die Formeln mit REPLACE bearbeiten (damit kann man auch Formeln verändern):

Range("C6:Y16").Replace What:="alter\Pfad\[alter Dateiname.xlsm]", Replacement:="neuer\Pfad\[neuer_Dateiname.xlsm]", lookat:=xlpart
Gruß Daniel

AW: Verknüpfung per Makro Ändern
12.04.2016 14:25:14
Daniel
Hallo
danke für die Antwort.
Das würde mir so nicht reichen.
So müsste ich den alten und neuen Pfad immer von Hand einfügen. Ich würde gerne das er den alten Pfad ausliest und den neuen über den Explorer per Auswahl nimmt.
Ich möchte quasi auf den Button drücken, die neue Datei auswählen und dann soll die neue Quelle hinterlegt sein.
Das wär mit Replace so nicht möglich oder?
Gruß
Daniel

Anzeige
AW: Verknüpfung per Makro Ändern
12.04.2016 14:48:08
Daniel
Hi
naja, die alte Datenquelle kannst du ja so auslesen wie du das vorgesehen hast.
und die neue Datenquelle kannst du auch genauso über das GetOpenFilename einlesen.
nur das Ändern der Zellbezüge musst du dann über Replace ausführen, wenn es nur in einem bestimmten Zellbereich erfolgen soll.
Da wo ich dann "alter\Pfad...", "neuer\Pfad..." hingeschrieben habe, musst du dann eben die entsprechenden Variablen einsetzen.
Beachte aber, dass in einer Formel der Dateiname in eckigen Klammern steht, dh die musst du dann natürlich erst noch einbauen.
Gruß Daniel

Anzeige
AW: Verknüpfung per Makro Ändern
12.04.2016 14:57:35
Daniel
Danke nochmal für die Antwort.
Ich hab das heute schon über 3h versucht und echt nicht geschafft. Auch mit Replace.
Wärst du so nett und könntest mir deine Gedanken zusammenbauen?
Würde mir echt helfen.
Gruß

AW: Verknüpfung per Makro Ändern
12.04.2016 15:17:35
Daniel
Hi
Sub Change_Link_Zellbereich()
Dim myLinks As Variant
Dim NewSource As String
Dim OldSource As String
Dim i As Integer
Dim x As Long
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) & "]"
NewSource = Application.GetOpenFilename(Title:="Ersetze " & Mid(OldSource, x + 1) & " durch: _
")
x = InStrRev(NewSource, "\")
NewSource = Left(NewSource, x) & "[" & Mid(NewSource, x + 1) & "]"
ThisWorkbook.Sheets("Tabelle1").Range("C6:Y16").Replace OldSource, NewSource, xlPart
Next
End Sub

den Tabellenblattnamen mussst du noch anpassen.
gruß Daniel

Anzeige
AW: Verknüpfung per Makro Ändern
12.04.2016 15:31:48
Daniel
Super!!
Besten Dank.
Eine Kleinigkeit wär noch, dass er mich 4-5 mal nach der neuen Datei fragt.
Ist das normal oder kann man das ändern?
Gruß und echt vielen Dank.

AW: Verknüpfung per Makro Ändern
12.04.2016 15:43:36
Daniel
Hi
naja du wirst so oft gefragt, wie du Links auf verschiedene Dateien hast.
Gruß Daniel

AW: Verknüpfung per Makro Ändern
12.04.2016 16:05:26
Daniel
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

Anzeige
AW: Verknüpfung per Makro Ändern
12.04.2016 16:05:33
Daniel
Ich hab es jetzt hinbekommen :)
Der "Fehler" war in der Schleife. So wird nur einmal nach dem Newfile gefragt.
Danke dir!
Sub Change_Link_Zellbereich()
Dim myLinks As Variant
Dim NewSource As String, NewFile As String
Dim OldSource As String
Dim i As Integer
Dim x As Long
If MsgBox("Neues Projekt anlegen?", vbYesNo + vbQuestion) = vbNo Then
MsgBox "Abbruch"
Exit Sub
End If
myLinks = ThisWorkbook.LinkSources
For i = 1 To UBound(myLinks)
If i = 1 Then
OldSource = CStr(myLinks(i))
x = InStrRev(OldSource, "\")
OldSource = Left(OldSource, x) & "[" & Mid(OldSource, x + 1) & "]"
NewFile = Application.GetOpenFilename(Title:="Ersetze " & Mid(OldSource, x + 1) & "  _
durch:")
End If
x = InStrRev(NewFile, "\")
NewSource = Left(NewFile, x) & "[" & Mid(NewFile, x + 1) & "]"
ThisWorkbook.Sheets("Tabelle1").Range("C6:Y19").Replace OldSource, NewSource, xlPart
Next
End Sub

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen
Forumthread
Beiträge