时间戳

首页 > 解决方案 > 使用 VBA 删除 powerpoint 上的内容

excel - 使用 VBA 删除 powerpoint 上的内容

问题描述

我有一个每周要尝试自动化的演示文稿。每周我都会删除前几周的所有内容，并使用 Excel 中的宏粘贴新数据。但是我不知道如何删除所有以前的内容。注意：我不想删除幻灯片，只删除幻灯片上的图片。

编辑：以下是我在 excel 中使用的代码，用于每周粘贴新数据。此代码适用于单张幻灯片。是否可以在粘贴新数据之前添加代码以删除前几周的数据？

Sub PasteAltSummaryToDeck()
'PURPOSE: Copy alt summary page and paste into weekly deck'

Dim myPresentation As Object
Dim mySlide As Object
Dim PowerPointApp As Object
Dim shp As Object
Dim MySlideArray As Variant
Dim MyRangeArray As Variant
Dim x As Long

'Create an Instance of PowerPoint
  On Error Resume Next

'Is PowerPoint already opened?
  Set PowerPointApp = GetObject(class:="PowerPoint.Application")

'Clear the error between errors
  Err.Clear

'If PowerPoint is not already open then Exit
  If PowerPointApp Is Nothing Then
    MsgBox "PowerPoint Presentation is not open, aborting."
    Exit Sub
  End If

'Handle if the PowerPoint Application is not found
  If Err.Number = 429 Then
    MsgBox "PowerPoint could not be found, aborting."
    Exit Sub
  End If

  On Error GoTo 0

'Make PowerPoint Visible and Active
  PowerPointApp.ActiveWindow.Panes(2).Activate

'Create a New Presentation
  Set myPresentation = PowerPointApp.ActivePresentation

'List of PPT Slides to Paste to
  MySlideArray = Array(11)

'List of Excel Ranges to Copy from
    MyRangeArray = Array(Sheet2.Range("F5:AS60"))

'Loop through Array data
  For x = LBound(MySlideArray) To UBound(MySlideArray)
    'Copy Excel Range
        MyRangeArray(x).Copy

'Paste to PowerPoint and position
  On Error Resume Next
    Set shp = myPresentation.Slides(MySlideArray(x)).Shapes.PasteSpecial(DataType:=2) 'Excel 2007-2010
    Set shp = PowerPointApp.ActiveWindow.Selection.ShapeRange 'Excel 2013
  On Error GoTo 0

'Center Object
  With myPresentation.PageSetup
    shp.Left = (.SlideWidth \ 2) - (shp.Width \ 2)
    shp.Top = (.SlideHeight \ 2) - (shp.Height \ 2)
  End With

  Next x

   'Record the date & time of procedure execution
    Range("ExportAltSumToPPT").Value = Format(Now(), "mm/dd/yy") & " - " & 
Format(TimeValue(Now), "hh:mm AM/PM")

'Transfer Complete
  Application.CutCopyMode = False
 ThisWorkbook.Activate
  MsgBox "Complete!"


End Sub

标签： excelvbapowerpoint

解决方案

要通过 Excel 删除幻灯片的内容，您可以使用以下代码：

Option Explicit

Sub remove_previous_shapes_in_PPT()
    Dim sl As PowerPoint.Slide, sl_cnt As Long, pr As Object, pr_name As String, ppt As Object
    Dim i As Long, j As Long
    Set ppt = GetObject(, "PowerPoint.Application")
    Set pr = ppt.Presentations(1)
    sl_cnt = pr.Slides.Count
    For j = sl_cnt To 2 Step -1
        Set sl = pr.Slides(j)
        For i = sl.Shapes.Count To 1 Step -1
            sl.Shapes(i).Delete
        Next i
    Next j
End Sub

这利用了遍历幻灯片计数和遍历幻灯片中形状的嵌套循环。在我上面的代码中，我只保留幻灯片 1（j如果您想删除第一张幻灯片内容，您可以将循环更改为 1，而不是 2）。

注意标记的项目as Object与绑定到 PPT 参考的项目。我没有完成使用您的特定 PPT 的步骤，因为我通常处理GetObject()活动 PPT 窗口，只打开 1 个演示文稿。

推荐阅读