Public Sub StartRecursionFolder()
Dim Pre As Presentation
Dim FolderPath As String
Dim pp As String
Dim id As String Dim oFileDialog As FileDialog
Set oFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
'Set Pre = Application.ActivePresentation
With oFileDialog
.AllowMultiSelect = False
'.InitialFileName = Pre.Path & "\"
If .Show = 0 Then Exit Sub
End With
FolderPath = oFileDialog.SelectedItems(1) & "\"
'递归处理
RecursionFolder FolderPath
'MsgBox "批处理完成"
End Sub
Public Sub PresentationHandle(ByVal FilePath As String)
Application.DisplayAlerts = ppAlertsNone
Dim Pre As Presentation
Dim mst As Master
Dim sld As Slide
Dim shp As Shape
Debug.Print FilePath
Set Pre = Application.Presentations.Open(FilePath)
'******************************母版的处理**********************
Dim dsg As Design
Debug.Print "模板个数"; Pre.Designs.Count For Each dsg In Pre.Designs Set mst = dsg.SlideMaster
For Each shp In mst.Shapes
'删除条件
Debug.Print shp.Width & "/" & shp.Height; " "; BetweenSize(shp.Width, 145, 160) And BetweenSize(shp.Height, 30, 55)
If BetweenSize(shp.Width, 145, 160) And BetweenSize(shp.Height, 30, 55) Then
shp.Delete
End If
Next shp If dsg.HasTitleMaster Then
Set mst = dsg.TitleMaster
For Each shp In mst.Shapes
'删除条件
Debug.Print shp.Width & "/" & shp.Height; " "; BetweenSize(shp.Width, 145, 160) And BetweenSize(shp.Height, 30, 55)
If BetweenSize(shp.Width, 145, 160) And BetweenSize(shp.Height, 30, 55) Then
shp.Delete
End If
Next shp
End If Next dsg For Each sld In Pre.Slides
For Each shp In sld.Shapes
'删除条件
If BetweenSize(shp.Width, 145, 160) And BetweenSize(shp.Height, 30, 55) Then
shp.Delete
End If
Next shp
Next sld DeleteShapsInPresentation Pre Pre.Save Pre.Close Set Pre = Nothing
Set mst = Nothing
Set sld = Nothing Application.DisplayAlerts = ppAlertsAll
End Sub
Private Function BetweenSize(ByVal Size As Double, ByVal MinSize As Double, ByVal MaxSize As Double) As Boolean
If Size >= MinSize And Size <= MaxSize Then
BetweenSize = True
Else
BetweenSize = False
End If
End Function
Public Sub RecursionFolder(ByVal FolderPath As String) '递归文件夹
'声明对象
Dim Fso As Object
Dim MainFolder As Object
Dim OneFolder As Object
Dim OneFile As Object
'实例化对象
Set Fso = CreateObject("Scripting.FileSystemObject")
Set MainFolder = Fso.GetFolder(FolderPath)
'对文件执行操作
For Each OneFile In MainFolder.Files
If OneFile.Name Like "*.ppt*" Then
'具体要做的事情
PresentationHandle OneFile.Path
End If
Next
'递归
For Each OneFolder In MainFolder.SubFolders
RecursionFolder OneFolder.Path
Next
'释放对象
Set Fso = Nothing
Set MainFolder = Nothing
End Sub Private Sub DeleteShapsInPresentation(ByVal Pre As Object)
Dim sld As Slide
Dim shp As Shape
Dim Txt As String
For Each sld In Pre.Slides
For Each shp In sld.Shapes
If shp.HasTextFrame = msoTrue Then
If shp.TextFrame.HasText Then
Txt = shp.TextFrame.TextRange.Text
If Txt Like "*更多免费资料下载请进*" Then
shp.Delete
End If
End If
End If
Next
Next
For Each shp In Pre.SlideMaster.Shapes
If shp.HasTextFrame = msoTrue Then
If shp.TextFrame.HasText Then
Txt = shp.TextFrame.TextRange.Text
If Txt Like "*更多免费资料下载请进*" Then
shp.Delete
End If
End If
End If
Next End Sub

  

20170709pptVBA递归删除LOGO图片与文字的更多相关文章

  1. ASP.NET(C#)图片加文字、图片水印,神啊,看看吧

    ASP.NET(C#)图片加文字.图片水印 一.图片上加文字: //using System.Drawing; //using System.IO; //using System.Drawing.Im ...

  2. ios图片添加文字或者水印

    在项目中,我们会对图片做一些处理,但是我们要记住,一般在客户端做图片处理的数量不宜太多,因为受设备性能的限制,如果批量的处理图片,将会带来交互体验性上的一些问题.首先让我们来看看在图片上添加文字的方法 ...

  3. iOS开发富文本制作 图片和文字/NSMutableParagraphStyle/NSMutableAttributedString

    /NSMutableParagraphStyle/NSMutableAttributedString 组合使 NSString * titlestr=@"日产GT-R"; NSMu ...

  4. CSS控制图片和文字在同一行显示且对齐的3种方法

    CSS控制图片和文字在同一行显示且对齐的3种方法 在 HTML 代码中,有时会需要在文字旁边加上一个图标. 默认情况,是图片置顶对齐,文字置底对齐,所以通常图片高,文字低,不能水平居中对齐. 常见方法 ...

  5. markdown 使用示例,包含常用的标题、图片、文字样式、代码块、链接等

    ps:博客园markdown不能自动生成列表,更好的阅读体验可访问我的个人博客http://www.isspark.com/archives/Markdown%E7%A4%BA%E4%BE%8B # ...

  6. python dict clear只能删除一层,不能够递归删除。

    void PyDict_Clear(PyObject *op) { dictobject *mp; dictentry *ep, *table; int table_is_malloced; Py_s ...

  7. 鼠标滑过图片变暗文字链接滑出jQuery特效

    效果体验:http://hovertree.com/texiao/jquery/7.htm HTML文件代码: <!DOCTYPE html> <html xmlns="h ...

  8. iOS开发小技巧--即时通讯项目:使用富文本在UILabel中显示图片和文字;使用富文本占位显示图片

    Label借助富文本显示图片 1.即时通讯项目中语音消息UI的实现,样式如图: 借助富文本在UILabel中显示图片和文字 // 1.创建一个可变的富文本 NSMutableAttributedStr ...

  9. 【File】递归删除文件夹中子级文件/夹,并删除文件夹

    今天有这样一个需求,需要删除某一个文件夹,但是文件夹中还有子级的文件 或者还可能会有文件夹在里面,所以就需要使用一个简单的递归才能将文件夹删除成功,包括文件夹中的子级文件/夹.!!! 其实很简单,就一 ...

随机推荐

  1. cocoapods 配置

    二.CocoaPods 安装 CocoaPods可以方便地通过Mac自带的RubyGems安装. 打开Terminal(Mac电脑自带的终端): (1).设置ruby的软件源 这是因为ruby的软件源 ...

  2. linux常用命令:cal 命令

    cal命令可以用来显示公历(阳历)日历.公历是现在国际通用的历法,又称格列历,通称阳历.“阳历”又名“太阳历”,系以地球绕行太阳一周为一年,为西方各国所通用,故又名“西历”. 1.命令格式: cal  ...

  3. android 图片大小适配,如何在不同屏幕上适配图片,如何设置可以自适应不同分辨率?

    android 图片大小适配,如何在不同屏幕上适配图片,如何设置可以自适应不同分辨率? Android为了适应不同的分辨率,需要将不同的图片放到不同的drawable目录下,分辨率的匹配规则如下:dr ...

  4. [转载]DropDownList三级菜单联动源码

    using System; using System.Collections.Generic; using System.Linq; using System.Web; using System.We ...

  5. Linux中Postfix虚拟用户及虚拟域(六)

    Postfix基于虚拟用户虚拟域的邮件架构 上图是一个几乎完整的邮件系统架构图,这里基于Mysql数据库进行用户认证,不管是Postfix.Dovecot.webmail都需要去Mysql数据库中进行 ...

  6. (mac)阿里云ECS服务器配置过程

    -----首先本人是半只脚入门的iOS开发者,弄这个只是单纯想多学点东西. -----阿里云服务器的配置选择:既然是学习用的,最最基础的配置就行了.1M带宽,1核1G...这就不详述了.没啥可选的,( ...

  7. Socket和ServletSocket的交互

    ServerSocket(int port) 是服务端绑定port端口,调accept()监听等待客户端连接,它返回一个连接队列中的一个socket. Socket(InetAddress addre ...

  8. python百分号%—%s、%d、%f

    百分号%表示占位符,在后续通过%传入真实的值 %s  拼接字符串,实际可以接受任何类型的值 %d  只能拼接整数数字 %.nf  四舍五入拼接浮点数,n表示保留到小数点后n位,不加.n默认保留6位小数 ...

  9. 关于RSU和股票期权(Stock Option)

    最近,和有些猎头沟通时,他们提到RSU的概念,特地搜了下,其和股票期权(Stock Option)差别如下: RSU 和Option 一般都是逐年实现的,比如Offer Letter签三年,上写的给你 ...

  10. python判断结构总结

    1.判断结构是允许程序针对不同情况执行不同指令序列的控制结构. 2.判断在Python中用if语句实现.简单的判断是用一个简单的if来实现的.两路判断通常使用if-else.多路判断用if-elif- ...