批量删除固定元素


选择一个图形,执行此代码后,所有幻灯片上和此图形位置、大小相同的图形都会被删除。

代码如下:

  1. Sub 批量删除()
  2. Dim oSlide As Slide, oShape As Shape
  3. Dim myWidth As Single, myHeight As Single, myTop As Single, myLeft As Single
  4. On Error Resume Next
  5. If ActiveWindow.Selection.ShapeRange.Count <> 1 Then
  6. If Err.Number <> 0 Then
  7. MsgBox "未选择任何对象。" & vbCrLf & "请先选择1个图形。", vbExclamation + vbOKOnly
  8. Err.Clear
  9. Exit Sub
  10. End If
  11. MsgBox "未选择图形或选择的图形超过1个。" & vbCrLf & "请先选择1个图形。", vbExclamation + vbOKOnly
  12. Exit Sub
  13. End If
  14. Set oShape = ActiveWindow.Selection.ShapeRange(1)
  15. myTop = oShape.Top
  16. myLeft = oShape.Left
  17. myHeight = oShape.Height
  18. myWidth = oShape.Width
  19. For Each oSlide In ActivePresentation.Slides
  20. For Each oShape In oSlide.Shapes
  21. '有时候图形会有一点移动或变形,所以采用了近似的算法来包容此情况'
  22. If Abs(myTop - oShape.Top) < 1 And Abs(myLeft - oShape.Left) < 1 And Abs(myHeight - oShape.Height) < 1 And Abs(myWidth - oShape.Width) < 1 Then
  23. oShape.Delete
  24. End If
  25. Next
  26. Next
  27. End Sub

音律 2022年5月17日 20:18 0 条评论 收藏文档
评论

暂无评论,我来发表第一篇评论!

发表评论