Grafiken in Powerpoint mit Excel löschen
30.06.2021 17:22:02
Egbert
da ich dieses Forum wirklich sehr gut finde möchte ich mich auch mal beteiligen.
Leider aktuell mit keiner Hilfe sondern einer Frage.
Wir haben ein Excelmakro das jeden Tag ca. 40 Dagramme aus Excel in eine Powerpoint datei einfügt.
Dazu steht in den Notizen auf der PP Seite folgender Text
>>auswertung1#Chart 11 in dem der Name des Charts in der Exceltabelle angegeben ist.
Und dann wird auf der Seite das Chart eingefügt.
Wir starten aus Excel das Makro, dann wird die PPTx Datei geladen und dann funktioniert alles super.
Nun müssen wir jeden Abend die Grafiken wieder von Hand löschen.
Daher dachte ich das mit dem folgenden Makro einfach die Grafiken von den Seiten wo der Tag drinsteht wieder lösche.
Leider geht das nur für die erste gefundene Seite.
Was mach ich falsch
(Die PPTX enthält auch noch 60 Seiten an denen nichts gemacht werden soll. Alle Grafiken löschen geht halt nicht ;-)
vielen Dank Egbert
Sub PPT_folien_Grafiken_loeschen20210411()
Dim lageVortrag As Object
Dim Presentations As Presentations
Dim ppApp As Object
Dim lageVortragSlides As Object
Dim regex As New Regexp
Dim matches As MatchCollection
Dim matchObj As match
Dim tabellenblatt As String
Dim diagramm As String
regex.Pattern = ">>(.*)#(.*) "" Then
meldung1 = "Die Datei " + presentationFile + "ist vorhanden. Sollen die Grafiken entfernt werden?"
OK1 = MsgBox(meldung1, (vbYesNo))
Else
Meldung2 = "Datei " + presentationFile + "ist NICHT vorhanden. Abbruch"
OK2 = MsgBox(Meldung2, vbOKOnly)
End If
If OK1 = 6 Then
Set lageVortrag = Presentations.Open(presentationFile)
'ListChartFromWorksheet ("Bettenauslastung")
Set lageVortragSlides = lageVortrag.Slides
For Each oSl In lageVortragSlides
For Each oSh In oSl.NotesPage.Shapes
If oSh.PlaceholderFormat.Type = ppPlaceholderBody Then
If oSh.HasTextFrame Then
If oSh.TextFrame.HasText Then
textinnotiz = oSh.TextFrame.TextRange.Text
Set matches = regex.Execute(oSh.TextFrame.TextRange.Text)
If matches.Count = 1 Then
Set matchObj = matches(0)
idslide = oSh.ID
' For Each shbild In ActivePresentation.Slides(seite).Shapes
For Each shbild In lageVortrag.Slides(idslide).Shapes
bildname = shbild.name
bnameteil = Left(bildname, 7)
If bnameteil = "Picture" Then shbild.Delete
Next
'tabellenblatt = CStr(matchObj.SubMatches.Item(0))
'diagramm = CStr(matchObj.SubMatches.Item(1))
'MsgBox tabellenblatt & vbCrLf & diagramm
' Grafik löschen 11.04.2021 Egbert
'yyy = entferne_Chart_aus_pptx(tabellenblatt, diagramm)
'If CopyChartFromWorksheet(tabellenblatt, diagramm) = 1 Then
'Sleep 1000
' PasteChartIntoSlide lageVortragSlides, oSl.SlideIndex
'End If
End If
End If
End If
End If
Next oSh
Next oSl
MsgBox "Die Diagramme wurden exportiert.", vbOKOnly, "Diagramm Export"
End If
End If
End Sub