Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Hilfe! PowerPoint und neue Excel Verknüpfunge

Betrifft: Hilfe! PowerPoint und neue Excel Verknüpfunge von: Anja
Geschrieben am: 14.08.2004 22:27:38

Hallo...

ich kann nicht mehr... ich bin echt am Verzweifeln...

Problembeschreibung:

habe eine Excel Datei heißt 12_08_2004.xls --->alle Verknüpfunge werden automatisch in der PowerPoint Präsentation (KPI.pp) aktualisiert.

Nur code wurde so progrmmiert, dass wenn gleich aufgebaute Excel Datei kommt zb 14_08_2004.xls die Präsentation muss nach sie dann aktualisiert werden.

Die Code habe ich vom Rainer... vom 20.07.2004
Früher hat das funktioniert, aber jetzt werden die neue Verknüpfungen absolut ignoriert. Und PP zeigt immer Sheets von der alte Datei...
Wo kann den da ein Fehler liegen... ??? Sollte man vielleicht was in der VBA Entwicklungsumgebung was ändern oder im Excel selbst...
Habe ich vielleicht irgendwas angecklickt oder geändert?

Die Code habe ich niciht angerührt...

.....
Aber Fehler liegt bestimmt in diesem Abschnitt:
For i = 1 To ppPres.Slides.count
For Each sh In ppPres.Slides(i).Shapes
If sh.Type = msoLinkedOLEObject Then
With sh.LinkFormat
'Externen Filebezug updaten
tmpLink = Replace(.SourceFullName, oldLinkfile, NewLinkfile, 1)
'Updaten der direkten Object Bezüge
tmpLink = Replace(tmpLink, onlyOldFileName, onlyNewFileName, 1)
.SourceFullName = tmpLink
.Update
End With
End If
Next
.....


da wo neu Verknüpfung definiert wird und upgedatet... Im Dialog zeigt er tatsächlich neu Excel Datei an...
Aber Update passiert einfach nicht!!!!!!

Bitte wenn ihr eine Idee habt... ich würde mich risig freuen...
Ich kann das nicht mehr ansehen...

BITTE!!!!

Viele Grüße

Anja


Hier ist die Code:

Option Explicit
Private Declare

Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal lpnShowCmd As Long) As Long

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
'************************
'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

'Abfrage ob neue Verknüpfungdatei definiert werden soll
Qe = MsgBox("Die aktuelle Verknüpfungdatei von " & Chr$(13) & ppPresName & Chr$(13) & _
    "ist derzeit die Datei " & Chr$(13) & _
    oldLinkfile & "." & Chr$(13) & _
    "Soll die Verknüpfungsdatei geändert werden ?", vbQuestion + vbYesNo, "Source Definition")
If Qe = vbYes Then
    'Wenn ja
    NewLinkfile = Application.GetOpenFilename("XLS Dateien (*.xls),", True, "Neue Verknüpfungsdatei auswählen", "Übernehmen", False)
    'sicherheitsabfrage
    Qe = MsgBox("Soll die Datei " & Chr$(13) & NewLinkfile & Chr$(13) & "als neue Verknüpfung definiert werden?", _
        vbQuestion + vbOKCancel, "Source Definition")
    If Qe = vbNo Then
        'Verwendung der bisherigen Datei um Update der Präsentation
        Qe = MsgBox("Die Definition der Datei" & Chr$(13) & _
            NewLinkfile & Chr$(13) & _
            " wurde abgebrochen," & Chr$(13) & _
            "Es wird die alte Datei " & oldLinkfile & "verwendet !", vbInformation + vbOKOnly, "Source Definition")
    Else
        'Neue Linkdatei wird geschrieben und zum Update verwendet
        Open iniFile For Output As #1
        'Schreiben der aktuell geöffneten Datei als Verknüpfung
            Write #1, NewLinkfile
        Close #1
    End If
End If
Set ppApp = CreateObject("PowerPoint.Application")
ppApp.Visible = msoTrue
Set ppPres = ppApp.Presentations.Open(ppFile)
'---------------------
'Verknüpfungen updaten
'Wenn die Verknüpfungdatei nicht geändert wurde
'werden nur die Werte aktualisiert
If NewLinkfile = "" Then
    For i = 1 To ppPres.Slides.count
        For Each sh In ppPres.Slides(i).Shapes
            If sh.Type = msoLinkedOLEObject Then
                With sh.LinkFormat
                    .Update
                End With
            End If
        Next
    Next i
Else
    'Die Verknüpfungsdatei wurde geändert
    'Dazu muss der Filenamen extrahiert werden
    'den die directen Object Bezüge müssen ebenfalls angepasst werden
    'Variante für alle Excel Versionen
    cBSl = 0
    For i = Len(oldLinkfile) To 1 Step -1
        If Mid(oldLinkfile, i, 1) = "\" Then
            onlyOldFileName = Right(oldLinkfile, Len(oldLinkfile) - i)
            Exit For
        End If
    Next i
    cBSl = 0
    For i = Len(NewLinkfile) To 1 Step -1
        If Mid(NewLinkfile, i, 1) = "\" Then
            onlyNewFileName = Right(NewLinkfile, Len(NewLinkfile) - i)
            Exit For
        End If
    Next i
    For i = 1 To ppPres.Slides.count
        For Each sh In ppPres.Slides(i).Shapes
            If sh.Type = msoLinkedOLEObject Then
                With sh.LinkFormat
                    'Externen Filebezug updaten
                    tmpLink = Replace(.SourceFullName, oldLinkfile, NewLinkfile, 1)
                    'Updaten der direkten Object Bezüge
                    tmpLink = Replace(tmpLink, onlyOldFileName, onlyNewFileName, 1)
                    .SourceFullName = tmpLink
                    .Update
                End With
            End If
        Next
    Next i
End If
'---------------------
ppPres.SlideShowSettings.Run
'ppApp.Quit
Set ppPres = Nothing
Set ppApp = Nothing
End Sub

  


Betrifft: AW: Hilfe! PowerPoint und neue Excel Verknüpfunge von: Ramses
Geschrieben am: 15.08.2004 10:16:58

Hallo

Kannst du die PP Datei und die XLS mal senden ?
Ohne Beispieldatei geht da nichts.
Ich habe hier eine Probe-Datei erstellt die total 30 verknüpfte Diagramme aufweist auf eine Tochtertabelle der 3. Generation, und die Updates funktionieren problemlos ?

Existieren die ursprünglichen Datenbereiche denn noch ?

Gruss Rainer


  


Betrifft: AW: Hilfe! PowerPoint und neue Excel Verknüpfunge von: Anja
Geschrieben am: 15.08.2004 10:56:24

Hallo Rainer,

ich habe den Fehler gefunden... Das Problem lag nicht in der Code... sondern bei mir.
Das Program wurde so programmiert, dass sie neu Link überschreibt nur in dem Fall wenn es ohne Leerzeichen genannt wird...

Und Name von meiner andere Datei hieß " Kopie von 14_08_2004.xls", also hat er das einfach die richtige länge nciht gesehen, und den letzten Ling genommen...

Also so kann ich es zu mindest erklären. Weiß nicht genau, aber als ich den Name geändert habe, ging es wieder....

Vielen Dank

und Gruß

Anja


  


Betrifft: Geschlossen o.T, von: Ramses
Geschrieben am: 15.08.2004 12:21:25

...


 

Beiträge aus den Excel-Beispielen zum Thema "Hilfe! PowerPoint und neue Excel Verknüpfunge"