20170709pptVBA递归删除LOGO图片与文字
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图片与文字的更多相关文章
- ASP.NET(C#)图片加文字、图片水印,神啊,看看吧
ASP.NET(C#)图片加文字.图片水印 一.图片上加文字: //using System.Drawing; //using System.IO; //using System.Drawing.Im ...
- ios图片添加文字或者水印
在项目中,我们会对图片做一些处理,但是我们要记住,一般在客户端做图片处理的数量不宜太多,因为受设备性能的限制,如果批量的处理图片,将会带来交互体验性上的一些问题.首先让我们来看看在图片上添加文字的方法 ...
- iOS开发富文本制作 图片和文字/NSMutableParagraphStyle/NSMutableAttributedString
/NSMutableParagraphStyle/NSMutableAttributedString 组合使 NSString * titlestr=@"日产GT-R"; NSMu ...
- CSS控制图片和文字在同一行显示且对齐的3种方法
CSS控制图片和文字在同一行显示且对齐的3种方法 在 HTML 代码中,有时会需要在文字旁边加上一个图标. 默认情况,是图片置顶对齐,文字置底对齐,所以通常图片高,文字低,不能水平居中对齐. 常见方法 ...
- markdown 使用示例,包含常用的标题、图片、文字样式、代码块、链接等
ps:博客园markdown不能自动生成列表,更好的阅读体验可访问我的个人博客http://www.isspark.com/archives/Markdown%E7%A4%BA%E4%BE%8B # ...
- python dict clear只能删除一层,不能够递归删除。
void PyDict_Clear(PyObject *op) { dictobject *mp; dictentry *ep, *table; int table_is_malloced; Py_s ...
- 鼠标滑过图片变暗文字链接滑出jQuery特效
效果体验:http://hovertree.com/texiao/jquery/7.htm HTML文件代码: <!DOCTYPE html> <html xmlns="h ...
- iOS开发小技巧--即时通讯项目:使用富文本在UILabel中显示图片和文字;使用富文本占位显示图片
Label借助富文本显示图片 1.即时通讯项目中语音消息UI的实现,样式如图: 借助富文本在UILabel中显示图片和文字 // 1.创建一个可变的富文本 NSMutableAttributedStr ...
- 【File】递归删除文件夹中子级文件/夹,并删除文件夹
今天有这样一个需求,需要删除某一个文件夹,但是文件夹中还有子级的文件 或者还可能会有文件夹在里面,所以就需要使用一个简单的递归才能将文件夹删除成功,包括文件夹中的子级文件/夹.!!! 其实很简单,就一 ...
随机推荐
- FastJson(阿里巴巴)基础
一.所需jar包: fastjson-x.x.xx.jar(本例使用fastjson-1.1.36.jar). 二.解析转化: 1.json字符串 < ------ > js trin ...
- 阿里云云主机swap功能设置实战案例
阿里云云主机swap功能设置实战案例 阿里云提供的云服务器(Elastic Compute Service,简称 ECS),是云主机的一种,当前采用的虚拟化驱动是Xen(这一点可以通过bios ven ...
- Js删除字符串中的指定字符串
案例一. 比如:原字符串 var StringFirst = "12:30:08"; 现在要删掉冒号,变成123008 就可以先split var splitFirst = Str ...
- P2322 [HNOI2006]最短母串问题
P2322 [HNOI2006]最短母串问题 AC自动机+bfs 题目要求:在AC自动机建的Trie图上找到一条最短链,包含所有带结尾标记的点 因为n<12,所以我们可以用二进制保存状态:某个带 ...
- xml声明中的standalone属性
晚上,在测试tinyxml的时候,发现其中声明了<?xml version="1.0" standalone="no" ?>,经查,其含义为stan ...
- 20145104张家明 《Java程序设计》第9周学习总结
20145104张家明 <Java程序设计>第9周学习总结 教材学习内容总结 第16章 -撰写应用程序是利用通信协议对数据库进行指令交换,以进行数据的增删查找. -JDBC目的:让Java ...
- codevs 1380 没有上司的舞会 - 树形动态规划
题目描述 Description Ural大学有N个职员,编号为1~N.他们有从属关系,也就是说他们的关系就像一棵以校长为根的树,父结点就是子结点的直接上司.每个职员有一个快乐指数.现在有个周年庆宴会 ...
- 0xc0000005:读取位置时发生访问冲突
这是空指针,比如: A* a=NULL; a->fun();//会提示标题错误,因为a没有分配空间
- BZOJ 2141 排队(树状数组套treap)
题目链接:http://61.187.179.132/JudgeOnline/problem.php?id=2141 题意:给出一个数列A,每次交换两个数的位置.输出交换后逆序对的个数. 思路:首先, ...
- 【angular2+typeScript+ng-zorro】Carousel 走马灯的左右方向控件实现
ng-zorro Carousel 走马灯的左右方向控件实现 ng-zorro框架的走马灯本身还没有左右方向控件的实现,作者只是在文档中(0.6x)中曝出几个方法接口,如图: 实现: 在根compon ...