Hyperlink Adresse ändern mit Inputbox
26.01.2015 09:20:22
Dieter(Drummer)
Anbei ein Makro aus dem Internet, dass alle Hyperlinks einer Mappe sucht und die alte Hyperlink Adresse in die neue Hyperlink Adresse ändert.
Da die neue Adresse im Makro eingesetzt werden muss, wäre es einfacher, wenn das Makro eine Box aufruft, in der die alte Adresse gezeigt wird und in der man die neue Adresse eingeben kann. Dann sollen alle gefundenen Adressen geändert werden.
Grundsätzliches:
Alle Hyperlink Adressen können, müssen aber nicht, bis auf die Datei, die am Ende steht, evtl. anders sein. Es reicht also, wenn bis auf den Dateinamen die Adresse geändert werden kann. Auch der Laufwerksbuchstabe kann anders sein (auch evtl. ein Server).
Wäre schön, wenn das geht.
Eine Beispiel Datei füge ich an: https://www.herber.de/bbs/user/95266.xlsm
Gruß,
Dieter(Drummer)
Sub ChangeHyperlinks()
Dim i As Integer 'Mx selbst eingefügt, fehlte im Makro
Dim sHyp As Hyperlink
Dim oldAddress As String
Dim newAddress As String
oldAddress = "C:\test\Vor Hyperlink.xlsx"
newAddress = "C:\Test\Test2\Vor Hyperlink.xlsx"
'alle Tabelle durchlesen
For i = 1 To Sheets.Count
For Each sHyp In Sheets(i).Hyperlinks
If InStr(1, sHyp.Address, oldAddress) Then
sHyp.Address = Mid(sHyp.Address, 1, InStr(1, sHyp.Address, oldAddress) - 1) & _
newAddress & Mid(sHyp.Address, InStr(1, sHyp.Address, oldAddress) + Len(oldAddress))
sHyp.TextToDisplay = sHyp.Address
End If
Next
Next i
End Sub