PPT删除相同性状大小的图片
Sub DeleteShapes()
Dim SelSlide As Slide
'Dim SelPicName As String ' 控件有标题名字
'Dim SelPicText As String ' 没名字只有说明的
Dim SelText1 As String ' 文本框
Dim SelText2 As String ' 文本框
Dim i As Long
If ActiveWindow.Selection.Type = ppSelectionNone Then
MsgBox (" 请选中待删除的形状！ ")
Else
' SelPicName = ActiveWindow.Selection.ShapeRange.Name
' SelPicName = ActiveWindow.Selection.ShapeRange.AlternativeText
SelText1 = ActiveWindow.Selection.ShapeRange.Width
SelText2 = ActiveWindow.Selection.ShapeRange.Height
If vbYes = MsgBox(" 是否要删除所有幻灯片中的同样的形状：“ " + SelText1 + " x " + SelText2 + " ”？ ", vbYesNo, " 信息提示 ") Then 'SelText 相应替换为 SelPicName 或 SelPicText
For Each SelSlide In ActivePresentation.Slides
On Error Resume Next
'SelSlide.Shapes(SelPicName).Delete ' 删有名字的最简单，直接删
For i = 1 To SelSlide.Shapes.Count ' 没名字的得匹配相关属性
'If SelSlide.Shapes.Item(i).AlternativeText = SelPicText Then
If SelSlide.Shapes.Item(i).Width = SelText1 And SelSlide.Shapes.Item(i).Height = SelText2 Then
'MsgBox ("11")
SelSlide.Shapes.Item(i).Delete
End If
Next
Next
End If
End If
End Sub