Verknüpfungen zu Powerpoint nach verschieben anpassen
22.10.2024 12:32:09
DerChris
folgendes Problem:
ich starte aus Excel nach Auswahl von Daten eine Powerpoint Präsentation. Dort habe ich verschiedene einzelne Zellen die mit meiner Excel Tabelle verknüpft sind.
Zu Beginn hat auch alles super funktioniert. Nun muss ich leider die beiden Dateien ab´n einen anderen Ort verschieben. Die Verknüpfungen in PPT verweisen aber auf den alten Pfad. Mein Versuch die Verknüpfungen manuell zu aktualisieren schlugen fehl.
Ich habe jetzt was gefunden, das könnte in Powerpoint funktionieren, aber muß wohl noch angepasst werden.
Meine Verknüpfungen gehen alle auf die gleiche Excel Datei und sehen etwa so aus:
C:\User\....\Desktop\.....\.......\Beurteilung.xlsm!PPT!Z3S33
C:\User\....\Desktop\.....\.......\Beurteilung.xlsm!PPT!Z3S37:Z3S38
C:\User\....\Desktop\.....\.......\Beurteilung.xlsm!DruckLS!NameMA
usw.
Folgendes habe ich gefunden, wer kann mir beim umbauen helfen? Es soll bei allen Verknüpfungen der gleiche Pfad, den ich wähle, eingetragen werden.
Sub VerknuepfungenAendern()
Dim Praes As Presentation, Blatt As Slide, Bild As Shape
Dim vDatei As Variant, sPfad As String, sExcelFile As String
Dim NeuerPfad As String
With Application.FileDialog(msoFileDialogFilePicker)
.InitialView = msoFileDialogViewDetails
.Title = "Bitte neue Exceldatei für Verknüpfung auswählen"
.ButtonName = "Auswählen"
.InitialFileName = "*.xls*"
.AllowMultiSelect = False
If .Show = 0 Then Exit Sub
sPfad = VBA.CurDir
vDatei = .SelectedItems(1)
sExcelFile = Mid(vDatei, Len(sPfad) + 2)
End With
Set Praes = ActivePresentation
For Each Blatt In Praes.Slides
For Each Bild In Blatt.Shapes
If Bild.Type = msoLinkedOLEObject Then
If InStr(1, Bild.OLEFormat.ProgID, "Excel.Chart") > 0 Then
'Diagramm in eigenem Register
'C:\TEST\MAPPE10.XLS!Diagramm1
NeuerPfad = Bild.LinkFormat.SourceFullName
NeuerPfad = vDatei & Mid(NeuerPfad, InStr(1, NeuerPfad, "!"))
Bild.LinkFormat.SourceFullName = NeuerPfad
End If
If InStr(Bild.OLEFormat.ProgID, "Excel.Sheet") > 0 Then
If InStr(1, Bild.LinkFormat.SourceFullName, "[") > 0 Then
'Diagramm eingebettet in Tabelle
'C:\TEST\MAPPE2.XLS!Tabelle1![MAPPE2.xls]Tabelle1 Diagramm 1
NeuerPfad = Bild.LinkFormat.SourceFullName
NeuerPfad = Mid(NeuerPfad, InStr(1, NeuerPfad, "!"))
NeuerPfad = vDatei & Mid(NeuerPfad, 1, InStr(2, NeuerPfad, "!")) _
& "[" & sExcelFile & Mid(NeuerPfad, InStr(1, NeuerPfad, "]"))
Bild.LinkFormat.SourceFullName = NeuerPfad
Else
'Tabellenbereich
'C:\TEST\MAPPE10.XLS!Tabelle1!Z3S1:Z7S3
NeuerPfad = Bild.LinkFormat.SourceFullName
NeuerPfad = vDatei & Mid(NeuerPfad, InStr(1, NeuerPfad, "!"))
Bild.LinkFormat.SourceFullName = NeuerPfad
End If
End If
End If
Next
Next
End Sub
Anzeige