Hallo Frank,
ich habe da mal etwas für dich (VBA) zusammen geschrieben. Bisher habe ich im Excel noch nie etwas mit Hyperlinks gemacht, darum war ich neugierig...
Es ist auf die schnelle runter geschrieben. Normalerweise gehört da noch eine Überprüfung rein, ob es unter den neuen Link überhaut eine Datei, oder mindestens ob es den Pfad gibt. Aber für den ersten Test sollte es reichen...
Wenn noch nicht geschehen, dann aktiviere das Ribbon-Menü "Entwicklertools" und starte den VBA-Editor (Visual Basic). Für dich spielt es erst einmal keine Rolle, ob du den Code in die Datei selbst (hasse ich), oder in eine zentrale Quellcode-Bibliothek ablegst. Wenn er im Editor zu sehen ist, den Cursor darein positionieren und den "Play" Button klicken...
Sub Hyperlink_verändern()
Dim i As Integer
Dim n As Integer
Dim t As String
Dim Dateiname As String
Dim Pfad_alt As String
Dim Pfad_neu As String
Dim Hyperlink As Excel.Hyperlink
Dim XLS_Sheet As Excel.Worksheet
Set XLS_Sheet = Excel.ActiveSheet
t = "C:\Daten"
Pfad_neu = VBA.InputBox("Wie soll der neue Pfad der Hyperlinks lauten?", "", t)
If VBA.Len(Pfad_neu) = 0 Then GoTo Abbruch
If VBA.StrComp(VBA.Right(Pfad_neu, 1), "", vbTextCompare) <> 0 Then Pfad_neu = Pfad_neu & ""
If MsgBox("Es sind " & XLS_Sheet.Hyperlinks.Count & " Hyperlinks in diesem Sheet." & vbCr & vbCr & _
"Sollen die alle auf den Pfad: " & vbCr & _
Pfad_neu & vbCr & _
"geändert werden?", vbQuestion + vbYesNo, "Hyperlink_verändern") = vbNo Then GoTo Abbruch
t = VBA.vbNullString
For i = 1 To XLS_Sheet.Hyperlinks.Count
Set Hyperlink = XLS_Sheet.Hyperlinks(i)
'alten Link zerlegen
t = Hyperlink.Address
n = InStrRev(t, "/")
If n > 0 Then
'nur ändern, wenn es auch ein "Web-Link" ist
Pfad_alt = VBA.Left(t, n)
Dateiname = VBA.Mid(t, n + 1)
'neuen Link zusammen bauen
Hyperlink.Address = Pfad_neu & Dateiname
'wenn die Anzeige in Excel auch noch "aktuell" sein soll, dann...
Hyperlink.TextToDisplay = Pfad_neu & Dateiname
End If
Next i
Abbruch:
Set Hyperlink = Nothing
Set XLS_Sheet = Nothing
End Sub
Viele Grüße
Mirko
).
