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

狮子vvbc

网上下载教学课件每页都有logo，用起来非常烦人，有的有几十页，每页删除非常麻烦，希望高手指点一下。
说明：1、logo不是在母版中添加的，所以在模板中去除不掉。
           2、添加的是同一个logo，但每页的名字不一样，所以也不能用vba进行批量删除。

图片的位置和大小是相同的，名字不同，个人水平有限，希望高手赐教。
http://club.excelhome.net/thread-300823-2-1.html               16楼的方法可以解决这个问题，可是我把那个vba用到我的ppt中就是不可以，应该是磅值找的不对，还是其他原因 ？



附件是下载的一个课件。

该贴已经同步到 狮子vvbc的微博

csnAlex

1. Sub Test()
   
2. '选择一个图形，执行此代码后，所有幻灯片上和此图形位置、大小相同的图形都会被删除
   
3. 
   
4. Dim oSlide As Slide, oShape As Shape
   
5. Dim myWidth As Single, myHeight As Single, myTop As Single, myLeft As Single
   
6. 
   
7. On Error Resume Next
   
8. If ActiveWindow.Selection.ShapeRange.Count <> 1 Then
   
9. If Err.Number <> 0 Then
   
10. MsgBox "未选择任何对象。" & vbCrLf & "请先选择1个图形。", vbExclamation + vbOKOnly
    
11. Err.Clear
    
12. Exit Sub
    
13. End If
    
14. MsgBox "未选择图形或选择的图形超过1个。" & vbCrLf & "请先选择1个图形。", vbExclamation + vbOKOnly
    
15. Exit Sub
    
16. End If
    
17. 
    
18. Set oShape = ActiveWindow.Selection.ShapeRange(1)
    
19. myTop = oShape.Top
    
20. myLeft = oShape.Left
    
21. myHeight = oShape.Height
    
22. myWidth = oShape.Width
    
23. 
    
24. For Each oSlide In ActivePresentation.Slides
    
25. For Each oShape In oSlide.Shapes
    
26. If oShape.Type = msoPicture Then
    
27. 
    
28. '有时候图形会有一点移动或变形，所以采用了近似的算法来包容此情况
    
29. 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
    
30. oShape.Delete
    
31. End If
    
32. End If
    
33. Next
    
34. Next
    
35. End Sub
    

复制代码

wx486

csnAlex 发表于 2013-7-17 15:06

谢谢分享，学习了。

wjhere

学习了，留下标记

keypress

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

keypress

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

1. Sub 删除()
   
2. '批量删除最后一个形状
   
3. Dim mySlide As Slide
   
4. Dim oCount As Integer
   
5. For Each mySlide In ActivePresentation.Slides
   
6.     oCount = mySlide.Shapes.Count
   
7.     mySlide.Shapes(oCount).Delete
   
8. Next
   
9. End Sub
   

复制代码

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

languocailuo

csnAlex 发表于 2013-7-17 15:06

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

wangyihong99

keypress 发表于 2013-8-10 16:35
注意到 logo 形状总位于幻灯片的最后一个所以可以这样写代码：

顺路帮忙一下
请教一下各位，比如这段 Application.ActivePresentation.Slides(1)   问题是：如何用msgbox 跳出当前是第几个放映灯？？？比如如上那段是人为的指第1个   ，谢谢！急用！再比如说 msgbox   .slides.counts是弹出当前总共有多少个放映灯片，那当前第几个是怎么样表达呢？
门外汉一个，大家不要笑话，百度找了几天了找不到！
刚好需要在PPT中给小孩子制作一个自动播放当前绘本页面对应的音频以及文本，谢谢！

weiyingde

languocailuo 发表于 2014-3-1 20:12
你好，高手。这个代码好像不能批量删除有填充颜色的图片，该怎么改动这个代码呢，求您赐教。

If oShape.Type = msoPicture Then
将下面一行改为：
If oShape.Type = msoPicture OR oShape.Type = msoAutoShape  Then ‘msoAutoShape为自选图形
……