Anpassung aller Hyperlinks für Bilder

Hallo,

ich wende mich nach mehreren Versuchen mit verschiedenen Beispielen an Euch.

Zur Situation: Ich habe eine Exceldatei mit mehreren Tabellenblättern in denen mehrere Bilder mit Hyperlinks hinterlegt sind. Diese Exceldatei dient als Vorlage und wird für ein neues Projekt jeweils verwendet.

Wenn also ein neues Projekt angelegt wird, müssen die Pfade der Hyperlinks geändert werden. Die Hyperlinks als solche rufen aus dem Excel Transaktionen, Reporte oder Systembefehle in einem SAP-System auf.

Pfad_Old: "C:\Vorlage\TR_SM59.sap"
Pfad_New: "C:\Projekte\Administrator\TR_SM59.sap"

Bisher hatte ich keinen Erfolg bei der Änderung des Pfades, außer mit einem aufgezeichneten Makro.


Diese Methode ist relativ starr, da ich alle Hyperlinks aller Bilder aktualisieren möchte.

Auf der anderen Seite wäre auch ein Makro möglich, dass die Verknüpfung im Laufwerk aufruft. Auch hier hatte ich verschiedene Beispiele ausprobiert, aber die Verknüpfung wurde nur bei manuellem Doppelklick ausgeführt.

LG

Const sNewPath = "C:\Projekte\Administrator\"  

Sub SetNewHyperlinkAddress()
    Dim oFso As Object, oHyperlink As Hyperlink
    
    Set oFso = CreateObject("Scripting.FileSystemObject")  
    
    For Each oHyperlink In ActiveSheet.Hyperlinks
        If oHyperlink.Type = msoHyperlinkShape Then
            oHyperlink.Address = sNewPath & oFso.GetFileName(oHyperlink.Address)
        End If
    Next
End Sub

Const sNewPath = "C:\Projekte\Administrator\"	  

Sub SetNewHyperlinkAddress()
    Dim oWks As Worksheet, oFso As Object, oHyperlink As Hyperlink
    
    Set oFso = CreateObject("Scripting.FileSystemObject")  
    
    For Each oWks In Sheets
        For Each oHyperlink In oWks.Hyperlinks
            If oHyperlink.Type = msoHyperlinkShape Then
                oHyperlink.Address = sNewPath & oFso.GetFileName(oHyperlink.Address)
            End If
        Next
    Next
End Sub