Hyperlink ändern in Abhängigkeit eines Begriffes

[PMH]

Hallo Forum,
ich habe eine Excel-Tabelle mit weit mehr als 50 Tabellenblättern. In den jeweiligen Tabellen-Blättern habe ich zig Hyperlinks in unterschiedlichsten Zellen hinterlegt; also insgesamt über die Excel-Tabelle einige 1.000 Hyperlinks. Diese Hyperlinks springen beispielhaft in irgendeine andere Excel-Tabelle oder zeigen z.B. ein Dokument an.

Ich möchte nun bestimmte Hyperlinks anpassen/ändern. Immer dann wenn in diesem Hyperlink ein bestimmter Text vorkommt (z.B. xyz.jpg), möchte ich diesen Hyperlink ändern in z.B. abc.jpg; alles andere von diesem Hyperlink soll gleich bleiben.
Da hiervon zig Hyperlinks betroffen sind (und ich weiß nicht in welchem Tabellen-Blatt) möchte ich dies gern per Makro durchführen.

Ich bekomm's nicht hin. [img]
Dateiupload bitte im Forum! So geht es: Klick mich!
2/22.gif[/img]Ich muß den Hyperling ja "String" für "String" abfragen bis ich den Treffer habe und diesen dann ersetzen.

Kann mich hier jemand bitte unterstützen. Danke, danke schon mal vorab.

[Klaus-Dieter]

Hallo,

ich habe eine Excel-Tabelle mit weit mehr als 50 Tabellenblättern.

auch ohne dir Datei gesehen zu haben, kann man da sagen, dass da sicher einiges optimiert werden kann.

[PMH]

Hallo Klaus-Dieter,
das habe ich jetzt nicht verstanden[img]
Dateiupload bitte im Forum! So geht es: Klick mich!
2/20.gif[/img].

Was soll da einiges optimiert werden. Sicherlich kann man mit einer DB arbeiten, aber Excel funktioniert super, schnell und einwandfrei.

Jetzt wollte ich Hyperlinks ändern (nicht den Pfad, das ist einfach) in Abhängigkeit eines bestimmten Textes in diesem Hyperlink.

Ich will's nochmal konkretisieren (hoffentlich): z.B.: Hyperlink alt/bisher + neu/wie's aussehen soll:
alt:   X:\Ordner A\Ordner AA\Ordner AAA\111 -aBild.jpg
neu: X:\Ordner A\Ordner AA\Ordner AAA\111 -Bild.jpg

Gruß PMH

[Klaus-Dieter]

Hallo,

das habe ich jetzt nicht verstanden[url=
Dateiupload bitte im Forum! So geht es: Klick mich!
]

ich beschäftige mich seit über 20 Jahren intensiv mit Excel, da war noch nie ein Projekt dabei, für das ich über 50 Seiten benötigt hätte.

[Kuwer]

Hallo PMH,

teste mal damit:

Sub HyperlinksAendern()

 Dim oWs As Worksheet

 Dim oZe As Range

 Dim strAlt As String, strNeu As String

 'strAlt = "-post-"

 strAlt = InputBox("Welcher Text soll ersetzt werden?")

 'strNeu = "-Posting-"

 strAlt = InputBox("Wie lautet der neue Text?")

 For Each oWs In ActiveWorkbook.Worksheets

   For Each oZe In oWs.Cells.SpecialCells(xlCellTypeConstants)

     If oZe.Hyperlinks.Count Then

       With oZe.Hyperlinks(1)

         .Address = Replace(.Address, strAlt, strNeu)

         .SubAddress = Replace(.SubAddress, strAlt, strNeu)

         .TextToDisplay = Replace(.TextToDisplay, strAlt, strNeu)

       End With

     End If

   Next oZe

 Next oWs

End Sub

Gruß Uwe

[PMH]

Hallo Kuwer,
vielen Dank für das Makro.

Ich hab's laufen lassen.
Nach 3/4 Sekunden kommt der Fehler: Laufzeitfehler '1004': keine Zellen gefunden.

Ich hab's dann mit Einzelschritten getestet.....bei "Next oZe" bleibt er hängen.

Muß ich da noch was am Makro anpassen ?

Kannst Du bitte mal "schauen". Danke, dank schon mal vorab

[Kuwer]

Hallo,

vermutlich hast Du leere Arbeitsblätter. Das sollte jetzt egal sein:

Sub HyperlinksAendern()

 Dim oWs As Worksheet

 Dim oZe As Range

 Dim strAlt As String, strNeu As String

 'strAlt = "-post-"

 strAlt = InputBox("Welcher Text soll ersetzt werden?")

 'strNeu = "-Posting-"

 strAlt = InputBox("Wie lautet der neue Text?")

 On Error Resume Next

 For Each oWs In ActiveWorkbook.Worksheets

   For Each oZe In oWs.Cells.SpecialCells(xlCellTypeConstants)

     If oZe.Hyperlinks.Count Then

       With oZe.Hyperlinks(1)

         .Address = Replace(.Address, strAlt, strNeu)

         .SubAddress = Replace(.SubAddress, strAlt, strNeu)

         .TextToDisplay = Replace(.TextToDisplay, strAlt, strNeu)

       End With

     End If

   Next oZe

 Next oWs

 On Error GoTo 0

End Sub

Gruß Uwe

[PMH]

Hallo Uwe,
ich hab' ja nun "Stundenlang" gefummelt und ich hab's rausbekommen.

Für die "Nachwelt" hier das Markro mit einem Beispieltext alt + neu:


Sub Hyperlink_Text_ändern()
Dim h As Hyperlink
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    For Each h In ws.Hyperlinks
        If InStr(1, h.Address, "xETB", vbTextCompare) > 0 Then
                   h.Address = Replace(h.Address, "xETB", "ETB", , , vbTextCompare)
        End If
    Next
Next
End Sub

[Kuwer]

Hallo,

jaaa, da stand ich auf der Leitung, die Hyperlinks nicht direkt abzuklappern.

Aber die InStr-Abfrage ist doch eigentlich überflüssig!?

Gruß Uwe

[PMH]

Hallo Klaus-Dieter,
wenn man z.B. ein Tabellenblatt pro Jahr in einer Excel-Tabelle hat und hier seit 1950 Daten führt, dann kommt man ganz schnell auf eine Excel-Tabelle mit mehr als 50 Tabellen-Blättern. Im Übrigen kenne ich einige Leute, die solch große Tabellen führen.

Ich beschäftige mich mit Excel erst seit kurzem und hab' so ein Problem (und ich bin auch nicht der Einzige).

Siehe die Lösung durch als "Profi" ; funktioniert prima und ist eigentlich ganz simpel ==> wenn man es kann. Ich hab' jetzt was dazu gelernt.