AW: Verknüpfungen aus Excel in Powerpoint
24.08.2007 04:33:00
fcs
Hallo a k,
du muss im Code natürlich in Zeile
QuelleNeu = "C:\Lokale Daten\Test\Test.xls"
den Pfad und Dateienamen entsprechend anpassen. Dann sollte es funktionieren. Ich hatte den Code unter Excel 2003 erstellt und auch noch mal unter Excel97 getestet. Er funktioniert mit kleiner Einschränkung auch unter Excel97.
Die Zeit ist nicht stehen geblieben, ich hab das Makro zwischenzeitlich erweitert. Die neue Verknüpfungsdatei kann jetzt in einem Dialogfenster ausgewählt werden. Es können die Verknüpfungen zu mehreren Exceldateien innerhalb einer PP-Präsentation neu festgelegt werden.
Leider hat PP97-VBA nicht das Equivalent zu GetOpenFilename in Excel97-VBA, weshalb ich hier in PP auf die Excel-Funktionalität zurückgreifen musste.
Gruß
Franz
Sub AnpassenVernuepfungVar1()
'Quelldatei(en) für Excel-Verknüpfungen in PP-Präsentation anpassen
'Für korrekte Funktion im VBA-Editor unter Extras-->Verweise _
den Verweis auf die Excel x.y Objekt Library aktivieren
Dim sld As Slide, sh As Shape, TabelleBereich As String, QuelleNeu As Variant
Dim QuelleAlt As String, arrQuelleAlt() As String, arrQuelleNeu() As String
Dim i%, j%, boVorhanden As Boolean, strBoxPrompt$, pos%
'Name(n) der verknüpften Exceldatei(en) finden
i = 0
ReDim arrQuelleAlt(0 To i)
For Each sld In ActivePresentation.Slides
For Each sh In sld.Shapes
If sh.Type = msoLinkedOLEObject Then
'Überprüfung, ob Objekt ein Excel-OLE-Objekt
If Left(sh.OLEFormat.ProgID, 6) = "Excel." Then
'Excel-Dateiname aus Quelle auslesen
QuelleAlt = Left(sh.LinkFormat.SourceFullName, InStr(1, _
sh.LinkFormat.SourceFullName, "!") - 1)
If i 0 Then
boVorhanden = False
'Prüfen, ob QuelleAlt schon im Array erfasst
For j = 1 To i
If arrQuelleAlt(j) = QuelleAlt Then
boVorhanden = True
Exit For
End If
Next
If boVorhanden = False Then
i = i + 1
ReDim Preserve arrQuelleAlt(1 To i)
arrQuelleAlt(i) = QuelleAlt
End If
Else
i = i + 1
ReDim arrQuelleAlt(1 To i)
arrQuelleAlt(i) = QuelleAlt
End If
End If
End If
Next
Next
If QuelleAlt "" Then
'Neue Verknüpfungsname(n) eingeben
ReDim arrQuelleNeu(1 To i)
For j = 1 To i
QuelleAlt = arrQuelleAlt(j)
QuelleNeu = Excel.Application.GetOpenFilename(Filefilter:="Exceldatei(*.xls),*.xls", _
Title:="Verknüpfung alt: " & QuelleAlt, MultiSelect:=False)
If QuelleNeu = False Then
'Abbrechen wurde gewählt, Verknüpfungsdatei wird nicht geändert
arrQuelleNeu(j) = QuelleAlt
Else
arrQuelleNeu(j) = QuelleNeu
End If
Next
' Application.DisplayAlerts = False 'Funktioniert in PP 97 nicht
For Each sld In ActivePresentation.Slides
For Each sh In sld.Shapes
If sh.Type = msoLinkedOLEObject Then
'Überprüfung, ob Objekt ein Excel-OLE-Objekt
If Left(sh.OLEFormat.ProgID, 6) = "Excel." Then
'Tabelle und Bereich bzw. Diagramm aus aktueller Quelle auslesen
TabelleBereich = Mid(sh.LinkFormat.SourceFullName, InStr(1, _
sh.LinkFormat.SourceFullName, "!"))
QuelleAlt = Left(sh.LinkFormat.SourceFullName, InStr(1, _
sh.LinkFormat.SourceFullName, "!") - 1)
'Neue Verknüpfung zuweisen
For j = 1 To i
If QuelleAlt = arrQuelleAlt(j) Then
sh.LinkFormat.SourceFullName = arrQuelleNeu(j) & TabelleBereich
Exit For
End If
Next
End If
End If
Next
Next
'Verknüpfungen aktualisieren
Application.ActivePresentation.UpdateLinks
' Application.DisplayAlerts = True 'Funktioniert in PP 97 nicht
Else
MsgBox "Es sind keine Excel-Verknüpfungen in der Datei vorhanden"
End If
End Sub