Daten aus Blättern kopieren-PowerPoint-Verknüpfung
25.05.2011 01:43:30
fcs
Hallo Meli,
...., und dass mir jemand eine VBA-Lösung dazu kurz programmieren könnte.
Auch wenn es für einen erfahrenen VBA-Programmierer im wesentlichen eine Fleißaufgabe ist, deine Wunschliste umzusetzen. Mit "kurz mal programmieren" ist das nicht gemacht, wenn man alle Randbedingungen berücksichtigt.
Hier eine Excel-Datei mit der der Ablauf gesteuert wird. Das Makro holt sich automatisch die Datei des Vormonats, wenn es sie im Verzeichnis findet.
Da es übersichtlicher und pflegeleichter ist werden alle Vorgaben und Eingaben im Tabellenblatt gemacht.
https://www.herber.de/bbs/user/74998.xls
In PowerPoint kannst du das Excel-Makro nicht einfach so verwenden, da dort die Eingabe-Möglichkeiten anders sind und "nur" die Verknüpfungen an den neuen Monat angepasst werden müssen. Das Makro kannst du starten, wenn die Datei für den neuen Monat mit den Verknüpfungen des Vormonats geöffnet ist.
Gruß
Franz
PowerPoint-Makro:
'Allgemeines Modul in MS Powerpoint
Sub VerknuepfungenAendernMeli_2()
Dim Praes As Presentation, Blatt As Slide, Bild As Shape
Dim sMonat As String, sJahr As String
Dim sSourceOld As String, sSourceNeu As String
Dim sPart_1_old As String, sPart_1_neu As String
Dim sPart_2_old As String, sPart_2_neu As String
Const sMsgTitel As String = "Vernüpfungen Aktualisieren"
'Eingabe von Monat und Jahr, auf das Aktualisert werden soll
sMonat = InputBox("Nummer des Monats auf den die Verknüpfungen aktualisiert werden sollen", _
_
sMsgTitel, IIf(Month(Date) = 1, 12, Month(Date) - 1))
If sMonat = "" Then GoTo Beenden
sJahr = InputBox("Jahr des Monats auf das die Verknüpfungen aktualisiert werden sollen", _
sMsgTitel, IIf(sMonat = "1", Year(Date) - 1, Year(Date)))
If sJahr = "" Then GoTo Beenden
'Berechnen der neuen Teilstrings
sPart_1_neu = "\" & sJahr & "\P" & Format(Val(sMonat), "00") & " " & Right(sJahr, 2) & "\"
sPart_2_neu = "Key financials P" & Format(Val(sMonat), "00") & " " & Right(sJahr, 2)
'Berechnen der zu ersetzenden Teilstrings in der Präsentation des Vormonats.
sPart_1_old = "\" & IIf(sMonat = "1", Format(Val(sJahr) - 1, "0000"), sJahr) _
& "\P" & Format(IIf(sMonat = "1", 12, Val(sMonat) - 1), "00") & " " _
& Right(IIf(sMonat = "1", Format(Val(sJahr) - 1, "0000"), sJahr), 2) & "\"
sPart_2_old = "Key financials P" & Format(IIf(sMonat = "1", 12, Val(sMonat) - 1), "00") _
& " " & Right(IIf(sMonat = "1", Format(Val(sJahr) - 1, "0000"), sJahr), 2)
'Kontrollanzeige
If MsgBox("Ersetze in den Dateinamen der Verknüpfungen" & vbLf _
& """" & sPart_1_old & """ durch """ & sPart_1_neu & """" & vbLf _
& """" & sPart_2_old & """ durch """ & sPart_2_neu & """", vbOKCancel) = vbCancel Then
GoTo Beenden
End If
Set Praes = ActivePresentation
'Verknüpfungen aktualisieren
For Each Blatt In Praes.Slides
For Each Bild In Blatt.Shapes
If Bild.Type = msoLinkedOLEObject Then
sSourceOld = Bild.LinkFormat.SourceFullName
If InStr(1, sSourceOld, sPart_1_old) > 0 _
And InStr(1, sSourceOld, sPart_2_old) > 0 Then
sSourceNeu = Replace(sSourceOld, sPart_1_old, sPart_1_neu)
sSourceNeu = Replace(sSourceNeu, sPart_2_old, sPart_2_neu)
Bild.LinkFormat.SourceFullName = sSourceNeu
End If
End If
NextBild:
Next
Next
Praes.UpdateLinks 'Diese Zeile erforderlich unter PP 2007, damit Darstellung in PP _
aktualisiert wird
Beenden:
Set Praes = Nothing: Set Bild = Nothing: Set Blatt = Nothing
End Sub