@Anja PP-Präsentation aktualisieren

'Begin Code Sequenz
Const ppPresName As String = "\POWER_POINT_KPI\KPI.ppt"
Const LinkIni As String = "\POWER_POINT_KPI\ppLink.ini"
Sub PP_Presentation_Start_and_Update_ObjectLinks()
'(C) Ramses
'Eine Powerpoint Präsentation enthält verschiedene verknüpfte Objecte auf eine EXCEL Tabelle
'Der Namen dieser Tabelle ändert sich jedoch immer wieder
'Um die manuellen Anpassungen zu umgehen werden diese automatisch upgedatet
'
'Dazu wird eine INI Datei angelegt in welcher die alte Verknüpfungsdatei gespeichert wird
'Existiert noch keine, wird eine INI Datei angelegt mit dem Bezug auf die AKTUELLE ARBEITSMAPPE
'Die Objecte in der Präsentation MÜSSEN beim erstmaligen Start also auf
'die aktuell geöffnete Mappe mit diesem Makro verweisen
'
'Beim starten wird dann gefragt ob auf eine neue Mappe Bezug genommen werden soll,
'der Benutzer wählt eine neue Datei aus ( Diese Datei MUSS Identisch sein mit der Originaldatei )
'd.h. die ursprünglich erstellte Datei darf nur unter einem anderen Namen gespeichert werden !!!
'Die Objectnamen dürfen NICHT geändert werden !!!
'
'Die Tabelle kann kaskadieren nach dem Vater - Sohn Prinzip
'Aus der Sohn-Tabelle können weitere Objecte in die Präsentation kopiert werden
'wenn die Objecte mit den neuen Werten auf diese Sohn Tabelle verweisen
'Bei einem Verweis auf die VATERTABELLE werden die Objecte in der Präsentation
'die in der Sohn-Tabelle vorhanden sind, nicht mehr dargestellt!!
'************************
'Integer Delaration
Dim i As Integer, Qe As Integer
'Object Deklaration
Dim ppApp As Object, ppPres As Object, sh As Object
'String Deklaration
Dim ppFile As String, iniFile As String
Dim LinkFile As String, oldLinkfile As String, NewLinkfile As String
Dim tmpLink As String, onlyOldFileName As String, onlyNewFileName As String, cBSl As Integer
'Variablen füllen
NewLinkfile = ""
'Prüfen ob PP-Datei vorhanden
ppFile = ThisWorkbook.path & ppPresName
If Dir(ppFile) = "" Then
      Beep
      Qe = MsgBox("Die Datei " & ppFile & " existiert nicht!", vbCritical + vbOKOnly, "Datei Fehler")
      Exit Sub
End If
'Zwischenspeichern des Namens für die Quelldatei
iniFile = ThisWorkbook.path & LinkIni
'Prüfen ob INI Datei vorhanden
If Dir(iniFile) = "" Then
    Qe = MsgBox("Die Datei " & Chr$(13) & iniFile & Chr$(13) & "wurde noch nicht definiert," & Chr$(13) & _
        "Es wird eine neue " & Chr$(13) & LinkIni & Chr$(13) & "erstellt mit der Quelle zu " & Chr$(13) & _
        ThisWorkbook.FullName, vbInformation + vbOKCancel, "Source Fehler")
    If Qe = vbCancel Then
        Qe = MsgBox("Das Erstellen der Datei " & Chr$(13) & _
            LinkIni & Chr$(13) & _
            " wurde abgebrochen," & Chr$(13) & _
            "Das Makro zum Starten der Präsentation wird " & Chr(13) & _
            "gestoppt und die PP Links nicht upgedatet !", vbInformation + vbOKOnly, "Source Fehler")
            Exit Sub
    End If
    'Erstellen einer neuen Link.ini
    Open iniFile For Output As #1
        'Schreiben der aktuell geöffneten Datei als Verknüpfung
        Print #1, ThisWorkbook.FullName
    Close #1
End If
'Schliessen einer eventuell geöffneten INI-Datei
Close #1
'Der Speicherort der INI Datei wird in der Const LiniIni definiert
Open iniFile For Input As #1
Do While Not EOF(1)
    'Einlesen der SourceQuelle für die Präsentation
    Input #1, oldLinkfile
Loop
'Schliessen der Datei
Close #1
Wurde getestet und tut :-)
Gruss Rainer