AW: Hyperlinks bearbeiten VBA
05.03.2018 22:13:08
firmus
Hi Hops,
prüfe mal diesen Code, das sollte ein passender Ansatz sein.
Option Explicit
Sub hyperlink_setzen()
Dim xAnzLinks As Long, x1 As Long, Zielspalte As Long
Dim ReplaceALT As String
Dim ReplaceNEU As String
Dim tmpC1 As String, tmpC2 As String
Zielspalte = 2 '2 = Spalte "B"
xAnzLinks = ActiveSheet.Hyperlinks.Count
ReplaceALT = "\Dateien\Ablage\Archiv\Archiv\"
ReplaceNEU = "\Dateien\Ablage\Archiv\"
For x1 = 1 To xAnzLinks
tmpC1 = ActiveSheet.Hyperlinks(x1).Address
If InStr(1, tmpC1, ReplaceALT) 0 Then 'nur ausgwählte Links ändern
MsgBox tmpC1
If ActiveSheet.Hyperlinks(x1).Parent.Column = Zielspalte Then
tmpC1 = Replace(tmpC1, ReplaceALT, ReplaceNEU)
MsgBox tmpC1
' HYPERLINK korrigieren
ActiveSheet.Hyperlinks(x1).Address = tmpC1
tmpC2 = "zeile " & ActiveSheet.Hyperlinks(x1).Parent.Row
tmpC2 = tmpC2 & "Spalte " & ActiveSheet.Hyperlinks(x1).Parent.Column
tmpC2 = tmpC2 & " am " & Date & " um " & Time
ActiveSheet.Hyperlinks(x1).ScreenTip = tmpC2
End If
End If
Next x1
End Sub
Anmerkung: Es werden ALLE Hyperlink eines Blattes durchgegangen, die 'Zielspalte' grenzt auf eine
gewünschte Spalte ein für den Austausch.
Gruß,
Firmus