"Displayalert = False" scheint nicht zu funktionieren und "AskToUpdatelinks = False" wird mir als Fehlerhaft angezeigt, wenn ich es Debugge.
Wichtig, ich habe den Code in PowerPoint stehen und nicht in Excel!
Außerdem ist das nur ein Ausschnitt des Codes! Für den gesamten Code, einfach bescheid geben :)
Ich freue mich über Hilfe,
Gruß Olli
Sub EntferneVerknuepfungenAusPowerPoint(pptFile As String)
'Verknüpfungen in einer geöffneten Präsentation von Excel 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
Application.DisplayAlerts = False
pptApp.Presentations.Open (pptFile)
Application.DisplayAlerts = False
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
Application.DisplayAlerts = True
pptPres.Close
If bWarNichtOffen = True Then pptApp.Quit
End If
End If
End Sub