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.

Sub Makro2()
  ActiveSheet.Shapes.Range(Array("Picture 16")).Select  
  Selection.ShapeRange.Item(1).Hyperlink.Address = _"..\..\Projekte\Administrator\"  
End Sub

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

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 193992

Url: https://administrator.de/forum/anpassung-aller-hyperlinks-fuer-bilder-193992.html

Ausgedruckt am: 23.12.2024 um 05:12 Uhr

3 Kommentare

Neuester Kommentar

Hallo 3xplor3r!

In etwa so:

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

Gruß Dieter

Hallo Dieter,

das Coding hat funktioniert.

Kannst du mir sagen, was die Zeilen 6 und 9 machen? Bei der Zeile 9 interessiert mich die rechte Seite vom Operand.

Gibt es noch die Möglichkeit statt dem ActiveSheet das Workbook also die gesamte Exceldatei zu aktualisieren?

LG

Hallo 3xplor3r!

Mit Codezeile 6 wird der Object-Variablen 'oFso' eine Klasse für das Dateisystem zugewiesen und in Codezeile 10 wird mit einer Funktion aus dieser Klasse das letzte Segment im Dateipfad ausgelesen und mit dem neuen Pfad verkettet, also in Deinem Beispiel: "C:\Projekte\Administrator\" + "TR_SM59.sap".

Mit der Codezeile 9 wird mit der Typ-Konstanten (rechts) geprüft, ob es sich um einen Shape-Hyperlink handelt. Somit werden nur Hyperlink-Adressen ersetzt, die mit einem Bild verknüpft sind.

Mit diesem Code werden alle Shape-Hyperlinks in der Arbeitsmappe ersetzt:

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