Hyperlinks ändern

Question

Tach,

ich möchte gerne einige Hyperlinks ändern habe auch hier schon die lösung gefunden (https://supportnet.de/listthread/1393931), aber der Frank hat noch was hinzugefügt und ich weiß nicht was.
Zu dem kommt noch ich habe keine ahnung von Programmieren und weiß nicht wo ich sachen ändern muss damit es auf meine Mappe angepasst wird.
Jetzt steht im Hyperlink bei mir "..\..\a\b\c.JPG" ich möchte gerne den Teil im a umschreiben zu a1 und im Spalte B,G und H befinden sich die Hyperlinks.
Nutze Excel2007.

Gruß Kyoshiro

Answer 1

Hi Kyoshiro,

versuche es mal mit dem folgenden Code (vorher eine Sicherheitskopie der Arbeitsmappe anlegen!):

Sub hyperlink_inhalte_ersetzen2()
Dim loZeile As Long
Dim hyAdresse As Hyperlink
Dim strAnzeige As String
With Worksheets("Tabelle1")
For loZeile = 1 To 1000
If .Cells(loZeile, 2).Hyperlinks.Count Then
strAnzeige = .Cells(loZeile, 2).Value
.Cells(loZeile, 2).Hyperlinks(1).TextToDisplay = .Cells(loZeile, 2).Hyperlinks(1).Address
.Cells(loZeile, 2).Hyperlinks(1).Delete
.Cells(loZeile, 2).Value = Replace(.Cells(loZeile, 2).Value, "\a\", "\a1\")
ActiveSheet.Hyperlinks.Add Anchor:=.Cells(loZeile, 2), Address:=Cells(loZeile, 2).Value, TextToDisplay:=strAnzeige
End If
If .Cells(loZeile, 7).Hyperlinks.Count Then
strAnzeige = .Cells(loZeile, 7).Value
.Cells(loZeile, 7).Hyperlinks(1).TextToDisplay = .Cells(loZeile, 7).Hyperlinks(1).Address
.Cells(loZeile, 7).Hyperlinks(1).Delete
.Cells(loZeile, 7).Value = Replace(.Cells(loZeile, 7).Value, "\a\", "\a1\")
ActiveSheet.Hyperlinks.Add Anchor:=.Cells(loZeile, 7), Address:=Cells(loZeile, 7).Value, TextToDisplay:=strAnzeige
End If
If .Cells(loZeile, 8).Hyperlinks.Count Then
strAnzeige = .Cells(loZeile, 8).Value
.Cells(loZeile, 8).Hyperlinks(1).TextToDisplay = .Cells(loZeile, 8).Hyperlinks(1).Address
.Cells(loZeile, 8).Hyperlinks(1).Delete
.Cells(loZeile, 8).Value = Replace(.Cells(loZeile, 8).Value, "\a\", "\a1\")
ActiveSheet.Hyperlinks.Add Anchor:=.Cells(loZeile, 8), Address:=Cells(loZeile, 8).Value, TextToDisplay:=strAnzeige
End If
Next loZeile
End With
End Sub

Bis später,
Karin

Answer 2

Hallo Karin,

erstmal danke schön.
Also es Funktioniert aber der ändert immer nur einige Hyperlinks und meiner meinung nach willkürlich z.B. in Zeile 1 dann 13 und 17.
Jedes mal wenn ich den Makro wieder starte macht er neue dann 2,14 usw.. Hab jetzt 20 mal es gestartet und sind immer noch nicht alle hyperlinks geändert. Kann man vielleicht das noch ändern?

Gruß Kyoshiro

Answer 3

Hallo,

habe jetzt rausgefunden das nur die Hyperlinks geändert werden die ich vorher anklicke und halt die Fehler meldung kommt.

Gruß Kyoshiro

Answer 4

Hi Kyoshiro,

seltsames Verhalten von Excel - kann ich nicht erklären. Versuche es mit diesem Code:

Sub hyperlink_inhalte_ersetzen2()
Dim loZeile As Long
Dim hyAdresse As Hyperlink
Dim strAnzeige As String
With Worksheets("Tabelle1")
For loZeile = 1 To 1000
If .Cells(loZeile, 2) <> "" Then
strAnzeige = Replace(.Cells(loZeile, 2).Value, "\a\", "\a1\")
On Error Resume Next
.Cells(loZeile, 2).Hyperlinks(1).Delete
On Error GoTo 0
ActiveSheet.Hyperlinks.Add Anchor:=.Cells(loZeile, 2), Address:=strAnzeige, TextToDisplay:=strAnzeige
End If
If .Cells(loZeile, 7) <> "" Then
strAnzeige = Replace(.Cells(loZeile, 7).Value, "\a\", "\a1\")
On Error Resume Next
.Cells(loZeile, 7).Hyperlinks(1).Delete
On Error GoTo 0
ActiveSheet.Hyperlinks.Add Anchor:=.Cells(loZeile, 7), Address:=strAnzeige, TextToDisplay:=strAnzeige
End If
If .Cells(loZeile, 8) <> "" Then
strAnzeige = Replace(.Cells(loZeile, 8).Value, "\a\", "\a1\")
On Error Resume Next
.Cells(loZeile, 8).Hyperlinks(1).Delete
On Error GoTo 0
ActiveSheet.Hyperlinks.Add Anchor:=.Cells(loZeile, 8), Address:=strAnzeige, TextToDisplay:=strAnzeige
End If
Next loZeile
End With
End Sub

Bis später,
Karin

Answer 5

Danke schön Karin,

habe ca.1000 Links per Hand bereits angeklickt und nochmal mit dem ersten code rüberrennen lassen.
Sind alle nun richtig verlinkt.
Der zweite Code funkioniert einwandfrei habe es benutzt bei der alte datei.

Gruß Kyoshiro