ich habe im Archiv einen Makro für die Powerpoint Verknüpfungen gefunden. Folgende Fragen habe ich dazu:
1) wie/wo kann ich es abändern, dass er mir von den 11 Verknüpfungen nur 10 mit dem abgefragten neuen Exceldatei ändert.... und zwar diejenige Verknüpfungen, die mit "NWS Key Financials Px 11" (Px steht für jeden Monat, z.B. P05 für Mai) verknüpft sind.
Dafür die letzte Verknüpfung mit "DART_NWS_Px 11 Reporting" mich extra abfragt, so dass ich die Möglichkeit habe, eine neue Datei dafür einzugeben.
2) Das Durchlaufen vom Makro dauert ziemlich lange (ca. 10 min). Liegt wahrscheinlich daran, dass in NWS Key Financials wiederum mit einer Datei B verlinkt ist, der mit Passwort geschützt ist. Und es fragt mich jedesmal nach dem Passwort.
* kann man das Passwort in VBA Makro einspeichern?
* kann man diese Funktion (Hintergrundverknüpfung aktualisieren) per VBA ausschalten, so dass es schneller durchläuft? ...oder muß ich auf die Lösung mit Wertekopie gehen, damit es eindeutig schneller wird?
Vielen herzlichen Dank im voraus für Eure Hilfe. Und nun das gefundene Makro:
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 die neue Exceldatei(*.xls) für die Verknüpfungsaktualisierung 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
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
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
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
gruss Meli