Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1724to1728
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Powerpoint Verknüpfung zu Excel löschen / deaktivieren (beim speichern)

Powerpoint Verknüpfung zu Excel löschen / deaktivieren (beim speichern)
29.11.2019 10:46:25
Olli

Hallo Zusammen,
ich habe eine PowerPoint Präsentation in der sich Tabellen befinden, die mit einer Excel verknüpft sind.
Ich habe einen Code geschrieben, der mir automatisch wenn ich will, einen neuen Ordner erstellt und eine Kopie der PowerPoint darin speichert (jede neue Kalenderwoche). Sozusagen als wöchentliches Backup.
Der Code funktioniert auch einwandfrei, einziges Problem ist jetzt, dass in der Kopie der PowerPoint ebenfalls die Tabellen synchronisiert werden. Das ist aber eher unvorteilhaft, da ich ja dann den Stand von zum Beispiel vor 3 Wochen nicht mehr kenne sondern alle abgespeicherten Backups gleich sind.
Meine Frage ist also, kann ich beim speichern der Kopie der PowerPoint, direkt einen Befehl oder eine Routine schreiben, die die aktuelle Verknüpfung zu Excel löscht, sodass sich immer nur die aktuellste Version der PowerPoint updated?
Vielleicht habt ihr Ideen zur Problemlösung, ich würde mich über Vorschläge freuen,
Gruß Olli

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Powerpoint Verknüpfung zu Excel löschen / deaktivieren (beim speichern)
29.11.2019 22:59:54
volti
Hallo Olli,
teste mal folgendes Makro, welches von Excel aus die Links in der aktiven Präsentation löschen soll.
Sub EntferneVerknuepfungen()
'Verknüpfungen in einer geöffneten Präsentation von Excel aus entfernen
 Dim pptApp As Object, pptPres As Object
 Dim pptObj As Object, pptFolie As Object, msoLinkedOLEObject As Integer
 msoLinkedOLEObject = 10
 On Error Resume Next
 Set pptApp = GetObject(, "PowerPoint.Application") 'geöffnete PPt ansprechen
 If Not pptApp Is Nothing Then
  If pptApp.Presentations.Count > 0 Then            'Mindestens 1 Präsentation offen
    Set pptPres = pptApp.ActivePresentation         'Aktive Präsentation nehmen
    For Each pptFolie In pptPres.slides             'Alle Folien durchgehen
      For Each pptObj In pptFolie.Shapes            'Alle Shapes durchgehen
         If pptObj.Type = msoLinkedOLEObject Then   'Ist Link?
            pptObj.LinkFormat.BreakLink             'Link entfernen
         End If
      Next pptObj
    Next pptFolie
  End If
 End If
 Set pptObj = Nothing
 Set pptFolie = Nothing
 Set pptPres = Nothing
 Set pptApp = Nothing
End Sub
viele Grüße
Karl-Heinz

Anzeige
AW: Powerpoint Verknüpfung zu Excel löschen / deaktivieren (beim speichern)
02.12.2019 08:13:47
Olli
Hey Karl-Heinz,
soweit funktioniert der Code super und fehlerfrei. Danke dafür!
Jetzt habe ich leider noch das Problem, dass ich den Code ja in der PowerPoint laufen lasse, die immer aktuell sein soll. Das bedeutet, dass wenn die Kopie der PowerPoint erstellt wird sind sowohl die Kopie als auch das Original geöffnet. Demnach wird die Verknüpfung auch aus beiden Dateien gelöscht.
Ist es denn überhaupt möglich deinen Code speziell auf die eine Datei anzuwenden (möglicherweise durch den Dateinamen) oder kennst du zufällig einen Trick dazu?
Ich versuche mich auch nochmal daran und sobald ich eine Lösung habe, melde ich mich nochmal.
Danke und Gruß
Olli

Option Explicit
Public KW As Variant
Sub Zelleauslesen()
Dim pfad As String, datei As String, blatt As String, bezug As String
pfad = "PfadDerExcelTabelle"
datei = "AutospeichernKW.xlsx"
blatt = "AktuelleKW"
bezug = "D3"
KW = GetValue(pfad, datei, blatt, bezug) 'Wert aus Zelle D3 in der Excl als KW speichern
Call NeuenOrdnerErstellen
Call DateispeichernmitKW
Call EntferneVerknuepfungen
End Sub
Private Function GetValue(pfad As String, datei As String, blatt As String, bezug As String) As  _
String
With CreateObject("Excel.Application")
With .Workbooks.Open(pfad & "\" & datei)
GetValue = .Sheets(blatt).Range(bezug).Value
Application.DisplayAlerts = False
End With
.Quit
End With
End Function
Sub NeuenOrdnerErstellen()
If Dir("PfadFürNeuenOrdner\KW_" & KW, vbDirectory) = "" Then
MkDir ("PfadFürNeuenOrdner\KW_" & KW)
MsgBox "Ordner für ''KW_" & KW & "'' wurde angelegt!"
Else
MsgBox "Ordner für ''KW_" & KW & "'' ist vorhanden!"
End If
End Sub
Sub DateispeichernmitKW()
Dim PPT As PowerPoint.Application
Dim pfad2 As String
Dim dateiname As String
Dim KWalsString As String
KWalsString = KW
Set PPT = New PowerPoint.Application
pfad2 = "PfadDerNeuenPowerPoint\KW_" & KW
dateiname = "speicherversuch"
Application.DisplayAlerts = False
PPT.ActivePresentation.SaveCopyAs FileName:=pfad2 & "\" & dateiname & "KW_" & KW & ".pptm" ' _
Neue Powerpoit abspeichern mit Name+KW aus der Excl
Application.DisplayAlerts = True
End Sub
Sub EntferneVerknuepfungen()
'Verknüpfungen in einer geöffneten Präsentation von Excel aus entfernen
Dim pptApp As Object, pptPres As Object
Dim pptObj As Object, pptFolie As Object, msoLinkedOLEObject As Integer
msoLinkedOLEObject = 10
On Error Resume Next
Set pptApp = GetObject(, "PowerPoint.Application") 'geöffnete PPt ansprechen
If Not pptApp Is Nothing Then
If pptApp.Presentations.Count > 0 Then            'Mindestens 1 Präsentation offen
Set pptPres = pptApp.ActivePresentation         'Aktive Präsentation nehmen
For Each pptFolie In pptPres.Slides             'Alle Folien durchgehen
For Each pptObj In pptFolie.Shapes            'Alle Shapes durchgehen
If pptObj.Type = msoLinkedOLEObject Then   'Ist Link?
pptObj.LinkFormat.BreakLink             'Link entfernen
End If
Next pptObj
Next pptFolie
End If
End If
Set pptObj = Nothing
Set pptFolie = Nothing
Set pptPres = Nothing
Set pptApp = Nothing
End Sub

Anzeige
AW: Powerpoint Verknüpfung zu Excel löschen / deaktivieren (beim speichern)
02.12.2019 14:10:00
volti
Hallo Olli,
es ist nicht so, dass in allen geöffneten PowerPoint-Mappen die Verknüpfugnen gelöschen werden.
Es werden nur die Verknüpfungen in der aktiven PPt gelöscht.
Je nachdem, wie und wann Du den Code aufrufst, ist es aber vielleicht Glücksache, welche PPt gerade aktiv ist.
Deshalb könnte man eine Sicherheitsabfrage in den Code einbauen.
Außerdem solltest Du die Sub auch nur aus der Sub zur Kopieerstellung aufrufen, dann dürfte nichts mehr passieren
Sub DateispeichernmitKW()
 
Dim PPT As PowerPoint.Application
Dim pfad2 As String
Dim dateiname As String
Dim KWalsString As String
 
KWalsString = KW
Set PPT = New PowerPoint.Application
 
pfad2 = "PfadDerNeuenPowerPoint\KW_" & KW
dateiname = "speicherversuch"
Application.DisplayAlerts = False
PPT.ActivePresentation.SaveCopyAs Filename:=pfad2 & "\" & dateiname & "KW_" & KW & ".pptm" 'Neue Powerpoit abspeichern mit Name+KW aus der Excl
Application.DisplayAlerts = True
Call EntferneVerknuepfungenAusPowerPoint
 
End Sub
Sub EntferneVerknuepfungenAusPowerPoint()
'Verknüpfungen in einer geöffneten Präsentation von Excel aus entfernen
 Dim pptApp As Object, pptPres As Object
 Dim pptObj As Object, pptFolie As Object, msoLinkedOLEObject As Integer
 msoLinkedOLEObject = 10
 On Error Resume Next
 Set pptApp = GetObject(, "PowerPoint.Application") 'geöffnete PPt ansprechen
 If Not pptApp Is Nothing Then
  If pptApp.Presentations.Count > 0 Then            'Mindestens 1 Präsentation offen
    Set pptPres = pptApp.ActivePresentation         'Aktive Präsentation nehmen
    If pptPres.Name Like "*KW_*.ppt*" Then          'Nur Präsentationen mit KW_ drin
     For Each pptFolie In pptPres.slides            'Alle Folien durchgehen
      For Each pptObj In pptFolie.Shapes            'Alle Shapes durchgehen
         If pptObj.Type = msoLinkedOLEObject Then   'Ist Link?
            pptObj.LinkFormat.BreakLink             'Link entfernen
         End If
      Next pptObj
     Next pptFolie
   End If
  End If
 End If
End Sub
viele Grüße
Karl-Heinz


Anzeige
AW: Powerpoint Verknüpfung zu Excel löschen / deaktivieren (beim speichern)
02.12.2019 15:01:24
Olli
Hallo Karl-Heinz,
an sich verstehe ich was du meinst und es macht auch Sinn aber ich glaube das Problem ist, dass die Backup Datei nie geöffnet ist sondern nur gespeichert wird, ich versuche die neue gespeicherte Datei mal Kurz zu öffnen und danach wieder direkt zu schließen. Währenddessen natürlich den Verknüpfung entfernen Sub laufen zu lassen.
Könnte das funktionieren?
Freue mich über andere Theorien,
Grüße
Olli
AW: Powerpoint Verknüpfung zu Excel löschen / deaktivieren (beim speichern)
02.12.2019 16:15:41
volti
Ah, jetzt verstehe ich.
Na klar, über PPT.ActivePresentation.SaveCopyAs erstellt Du nur eine Kopie der Datei.
Naja, dann müsste die Kopie noch mal geöffnet werden, die Links rausgemacht werden und wieder abgespeichert werden. Da stimme ich Dir zu.
Am besten den Dateinamen beim Aufruf der Sub mitgeben:
Call EntferneVerknuepfungenAusPowerPoint (pfad2 & "\" & dateiname & "KW_" & KW & ".pptm")
Sub EntferneVerknuepfungenAusPowerPoint(pptFile As String)
'Verknüpfungen in einer geöffneten Präsentation von Exce aus entfernen
 Dim pptApp As Object, pptPres As Object, bWarNichtOffen As Boolean
 Dim pptObj As Object, pptFolie As Object, msoLinkedOLEObject As Integer
 msoLinkedOLEObject = 10
 On Error Resume Next
 Set pptApp = GetObject(, "PowerPoint.Application") 'geöffnete PPt ansprechen
 If pptApp Is Nothing Then
    Set pptApp = CreateObject("PowerPoint.Application")
    bWarNichtOffen = True
 End If
 If Not pptApp Is Nothing Then
  If Dir$(pptFile) <> "" Then
   pptApp.Presentations.Open (pptFile)
   Set pptPres = pptApp.ActivePresentation           'Aktive Präsentation nehmen
   For Each pptFolie In pptPres.slides               'Alle Folien durchgehen
       For Each pptObj In pptFolie.Shapes            'Alle Shapes durchgehen
          If pptObj.Type = msoLinkedOLEObject Then   'Ist Link?
             pptObj.LinkFormat.BreakLink             'Link entfernen
          End If
       Next pptObj
   Next pptFolie
   pptPres.Save
   pptPres.Close
   If bWarNichtOffen = True Then pptApp.Quit
  End If
 End If
End Sub
viele Grüße
Karl-Heinz

Anzeige
AW: Powerpoint Verknüpfung zu Excel löschen / deaktivieren (beim speichern)
02.12.2019 16:28:12
Olli
Oh mein Gott, du bist echt ein Genie,
Ich hab ausversehen gleichzeitig geantwortet wie du, ignorier meine letzte Frage einfach!
So wie es aussieht funktioniert alles einwandfrei, ich danke dir!
Falls ich nochmal Fragen habe, weiß ich, bei wem ich mich melden werde ;)
Gruß
Olli
AW: Powerpoint Verknüpfung zu Excel löschen / deaktivieren (beim speichern)
02.12.2019 16:22:46
Olli
Ich habe es jetzt nochmal so versuch aber ich weiß nicht, was ich falsch gemacht habe...
Ich möchte lediglich die neu abgespeicherte Datei vor deinem Code öffnen, damit sie als "Active presentation" angesehen wird. Nach der Prozedur soll sie aber bestenfalls auch wieder geschlossen werden.
Ich habe nun das hier probiert, scheint laut Debugger aber mächtig falsch zu sein...
Ich habe zu deinem Code lediglich den Code ab "Dim pptDatei As PowerPoint.Application" bis zur "pptDatei.Open" Zeile geschrieben.
Freue mich über Hilfe!
Gruß Olli

Sub EntferneVerknuepfungenAusPowerPoint()
'Verknüpfungen in einer geöffneten Präsentation von Excel aus entfernen
Dim pptApp As Object, pptPres As Object
Dim pptObj As Object, pptFolie As Object, msoLinkedOLEObject As Integer
Dim pptDatei As PowerPoint.Application  'ab hier ist der Code von mir
Dim pfad2 As String
Dim dateiname As String
Dim KWalsString As String
pfad2 = "OrtderneuabgespeichertenPowerPointDatei\KW_" & KW
dateiname = "speicherversuch"
KWalsString = KW
Set pptDatei = New PowerPoint.Application
pptDatei.Visible = True
pptDatei.Presentations.Open FileName:=pfad2 & "\" & dateiname & "KW_" & KW & ".pptm"  'bis hier  _
ist der Code von mir
msoLinkedOLEObject = 10
On Error Resume Next
Set pptApp = GetObject(, "PowerPoint.Application") 'ge?ffnete PPt ansprechen
If Not pptApp Is Nothing Then
If pptApp.Presentations.Count > 0 Then            'Mindestens 1 Pr?sentation offen
Set pptPres = pptApp.ActivePresentation         'Aktive Pr?sentation nehmen
If pptPres.Name Like "*KW_*.ppt*" Then          'Nur Pr?sentationen mit KW_ drin
For Each pptFolie In pptPres.Slides            'Alle Folien durchgehen
For Each pptObj In pptFolie.Shapes            'Alle Shapes durchgehen
If pptObj.Type = msoLinkedOLEObject Then   'Ist Link?
pptObj.LinkFormat.BreakLink             'Link entfernen
End If
Next pptObj
Next pptFolie
End If
End If
End If
End Sub

Anzeige

9 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige