使用VBA删除powerpoint上的内容
使用VBA删除powerpoint上的内容
提问于 2019-10-15 02:35:21
我有一个每周的演示文稿，我正试图将其自动化。每周我都会删除前几周的所有内容，并使用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回答 2
Stack Overflow用户
回答已采纳
发布于 2019-10-15 02:44:21
试试这个；
Sub deletepics()
'variables
Dim slide As slide
Dim y As Long
'loop through slides backwards and with the slides shapes if they are pictures then delete
For Each slide In ActivePresentation.Slides
For y = slide.Shapes.Count To 1 Step -1
With slide.Shapes(y)
If .Type = msoPicture Then
.Delete
End If
End With
Next
Next
End Sub编辑:如果你只想删除幻灯片14到2上的图像，你可以这样做。忽略我的评论，他们错了。但下面的代码将为您工作。
Sub deletepics()
'variables
Dim slide As slide
Dim y As Long
'loop through slides backwards and with the slides shapes if they are pictures then delete
For y = ActivePresentation.Slides.Count To 2 Step -1
If y <> 14 Then
Set sldTemp = ActivePresentation.Slides(y)
For lngCount = sldTemp.Shapes.Count To 1 Step -1
With sldTemp.Shapes(lngCount)
If .Type = msoPicture Then
.Delete
End If
End With
Next
End If
Next
End SubStack Overflow用户
发布于 2019-10-15 03:15:05
通过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的步骤，因为我通常处理活动PPT窗口的GetObject()，只有一个演示文稿打开。
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/58382328
复制相关文章
相似问题
腾讯云开发者
