從VBA EXCEL MACRO中刪除PowerPoint中的舊圖表

Question

我想在某些PowerPoint演示文稿中刪除幾個不同的舊圖表，我要刪除的所有項目都稱為“對象n”。

我已經嘗試過一些不同的代碼，但是其中任何一個都沒有。 問題是我無法獲得形狀名稱。

Set ppApp = GetObject(, "Powerpoint.Application")

Set ppPres = ppApp.ActivePresentation

Set PPSLIDE = ppPres.Slides

For Each PPShape In ppApp.ActiveWindow.Selection.SlideRange.Shapes

    If Left$(PPShape.Name, 6) = "Object" Then

        PPShape.Delete
    End If

Next PPShape

Answer 1

我想你需要這樣的東西：

Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim ppSlide As PowerPoint.Slide
Dim ppShape As PowerPoint.Shape

Set ppApp = GetObject(, "Powerpoint.Application")
Set ppPres = ppApp.ActivePresentation

For Each ppSlide In ppPres.Slides
    For Each ppShape In ppSlide.Shapes
        If Left$(ppShape.Name, 6) = "Object" Then

            ppShape.Delete

        End If
    Next ppShape
Next ppSlide

編輯

我做了這個演講：

它包含三個具有以下形狀的幻燈片：

• 幻燈片1橢圓3
• 幻燈片1矩形4
• 幻燈片1 5點明星5
• 幻燈片2對象1
• 幻燈片2對象2
• 幻燈片2表3
• 幻燈片2等腰三角形4
• 幻燈片3對象1
• 幻燈片3對象2
• 幻燈片3對象3
• 幻燈片3右箭頭4

我必須使用VBA重命名圖表。 某些粘貼為Microsoft Office圖形對象的名稱為“圖表x”，其他粘貼為圖片的名稱為“圖片y”。

我在Excel工作簿中使用了此確切過程（與昨天發布的內容相同）：

Sub KillPowerPointCharts()
  Dim ppApp As PowerPoint.Application
  Dim ppPres As PowerPoint.Presentation
  Dim ppSlide As PowerPoint.Slide
  Dim ppShape As PowerPoint.Shape

  Set ppApp = GetObject(, "Powerpoint.Application")
  Set ppPres = ppApp.ActivePresentation

  For Each ppSlide In ppPres.Slides
    For Each ppShape In ppSlide.Shapes
      If Left$(ppShape.Name, 6) = "Object" Then

        ppShape.Delete

      End If
    Next ppShape
  Next ppSlide
End Sub

Excel工作簿已添加以下參考（VB編輯器>工具菜單>參考）：Microsoft PowerPoint 16.0對象庫

版本號（16.0）無關緊要。 它應該在Office 16（2016），15（2013），14（2010），12（2007）甚至更早版本中工作。 只需在參考列表中找到PowerPoint，然后進行檢查即可。

或者，使用“后期綁定”，然后將所有聲明的類型從PowerPoint.Something更改為Object 。

我運行了上面的過程，沒有遇到錯誤。 一些（不是全部）圖表被刪除。 我第二次運行代碼，其余代碼被刪除。 這可能是兩個應用程序之間的時間問題。 知道這可能是一個問題后，我對合並循環的過程做了一些小的修改：

Sub KillPowerPointCharts()
  Dim ppApp As PowerPoint.Application
  Dim ppPres As PowerPoint.Presentation
  Dim ppSlide As PowerPoint.Slide
  Dim ppShape As PowerPoint.Shape
  Dim i As Long

  Set ppApp = GetObject(, "Powerpoint.Application")
  Set ppPres = ppApp.ActivePresentation

  For i = 1 To 2
    For Each ppSlide In ppPres.Slides
      For Each ppShape In ppSlide.Shapes
        If Left$(ppShape.Name, 6) = "Object" Then

          ppShape.Delete

        End If
      Next ppShape
    Next ppSlide
  Next
End Sub

此過程取出了所有圖表。