网上下载教学课件批量删除logo

user_rewjb

网上下载教学课件每页都有logo，用起来非常烦人，有的有几十页，每页删除非常麻烦，希望高手指点一下。
说明：1、logo不是在母版中添加的，所以在模板中去除不掉。
2、添加的是同一个logo，但每页的名字不一样，所以也不能用vba进行批量删除。
图片的位置和大小是相同的，名字不同，个人水平有限，希望高手赐教。
16楼的方法可以解决这个问题，可是我把那个vba用到我的ppt中就是不可以，应该是磅值找的不对，还是其他原因 ？
附件是下载的一个课件。

applezj

• Sub Test()
  
• '选择一个图形，执行此代码后，所有幻灯片上和此图形位置、大小相同的图形都会被删除
  
• 
  
• Dim oSlide As Slide, oShape As Shape
  
• Dim myWidth As Single, myHeight As Single, myTop As Single, myLeft As Single
  
• 
  
• On Error Resume Next
  
• If ActiveWindow.Selection.ShapeRange.Count <> 1 Then
  
• If Err.Number <> 0 Then
  
• MsgBox &quot;未选择任何对象。&quot; & vbCrLf & &quot;请先选择1个图形。&quot;, vbExclamation + vbOKOnly
  
• Err.Clear
  
• Exit Sub
  
• End If
  
• MsgBox &quot;未选择图形或选择的图形超过1个。&quot; & vbCrLf & &quot;请先选择1个图形。&quot;, vbExclamation + vbOKOnly
  
• Exit Sub
  
• End If
  
• 
  
• Set oShape = ActiveWindow.Selection.ShapeRange(1)
  
• myTop = oShape.Top
  
• myLeft = oShape.Left
  
• myHeight = oShape.Height
  
• myWidth = oShape.Width
  
• 
  
• For Each oSlide In ActivePresentation.Slides
  
• For Each oShape In oSlide.Shapes
  
• If oShape.Type = msoPicture Then
  
• 
  
• '有时候图形会有一点移动或变形，所以采用了近似的算法来包容此情况
  
• 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
  
• oShape.Delete
  
• End If
  
• End If
  
• Next
  
• Next
  
• End Sub
  

复制代码

user_huncw

谢谢分享，学习了。

ronghee

学习了，留下标记

wanghe410

代码可用，收藏！
另外，这个ppt制作业余，居然在每页上单独贴logo，一般我会贴在母版中。
此外，如果不想让别人动logo，可以将logo嵌入背景图片中，或者加入隐形的logo。呵呵

半支烟

注意到 logo 形状总位于幻灯片的最后一个所以可以这样写代码：

• Sub 删除()
  
• '批量删除最后一个形状
  
• Dim mySlide As Slide
  
• Dim oCount As Integer
  
• For Each mySlide In ActivePresentation.Slides
  
•     oCount = mySlide.Shapes.Count
  
•     mySlide.Shapes(oCount).Delete
  
• Next
  
• End Sub
  

复制代码
唯一的问题是，这个代码容易误伤，呵呵

redappleisme

你好，高手。这个代码好像不能批量删除有填充颜色的图片，该怎么改动这个代码呢，求您赐教。