利用VBA给文档批量添加水印

直接复制代码到编译器中运行，选择文件文件夹和图片，将进行批处理，进行水印的批量添加，添加完成后可以看到存储的文件副本为“文件名+水印后”

注：
为保证水印可以铺满文档，所以图片水印默认扩大为1.5倍

宏代码：

Rem 这里是主程序
Sub 批量获取文件路径()
Dim fd As FileDialog
Dim fso As Object
Dim arr() '存储每次遍历到的文件夹的子文件夹
Dim brr() '临时存储每次遍历到的文件夹的子文件夹
Dim crr() '存储所有文件夹
Dim drr() '存储所有Word文件路径
Dim myFolder As Object
Dim subFolder As Variant
Dim i As Long
Dim j As Long
Dim m As Long
Dim myFile As Object
Dim 后缀 As String
Dim t0 As Single
Dim fd1 As FileDialog
Dim 水印图片路径 As Stringt0 = Timer
i = 0: j = 0: m = 0
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Set fso = CreateObject("Scripting.FileSystemObject")With fd.Title = "选择主文件夹"If .Show Theni = i + 1ReDim Preserve crr(1 To i)crr(i) = .SelectedItems(1)arr = crrSet fd1 = Application.FileDialog(msoFileDialogFilePicker)With fd1.AllowMultiSelect = False.Title = "选择图片水印文件".Filters.Clear.Filters.add "图片文件", "*.png;*.jpeg;*.jpg", 1.Filters.add "所有文件", "*.*", 2If .Show Then水印图片路径 = .SelectedItems(1)End IfEnd WithSet fd1 = NothingOn Error Resume NextDo While Err.Number = 0For j = LBound(arr) To UBound(arr)Set myFolder = fso.GetFolder(arr(j))If myFolder.subFolders.Count > 0 ThenFor Each subFolder In myFolder.subFoldersi = i + 1ReDim Preserve crr(1 To i)crr(i) = subFolder.Pathm = m + 1ReDim Preserve brr(1 To m)brr(m) = subFolder.PathNextEnd IfNextm = 0arr = brrErase brrLoopOn Error GoTo 0i = 0For j = LBound(crr) To UBound(crr)'                Debug.Print j, crr(j)Set myFolder = fso.GetFolder(crr(j))For Each myFile In myFolder.Files后缀 = fso.GetExtensionName(myFile.Path)If 后缀 Like "doc*" And Not 后缀 Like "*~$*" Theni = i + 1ReDim Preserve drr(1 To i)drr(i) = myFile.PathEnd IfNextNextFor j = LBound(drr) To UBound(drr)Rem 此处以下为调用的处理过程Application.ScreenUpdating = FalseCall 遍历节(drr(j), 水印图片路径)Application.ScreenUpdating = TrueRem 此处以上为调用的处理过程Debug.Print Format(j, String(Len(CStr(UBound(drr))), "0")), drr(j), "添加水印完成"NextEnd If
End WithSet fd = Nothing
Set fso = Nothing
Set myFolder = NothingDebug.Print "完成   共对" & UBound(drr) & "个文件添加了水印   用时" & Timer - t0 & "秒"
End Sub
Sub 遍历节(文件名, 水印图片路径 As String)
Dim aDoc As Document
Dim sec As Section
Dim hf As HeaderFooter
Dim fso As Object
Dim fName As String
Dim fNewName As StringSet aDoc = Documents.Open(文件名)
Set fso = CreateObject("Scripting.FileSystemObject")fNewName = aDoc.Path & "\" & fso.GetBaseName(文件名) & "-水印后." & fso.GetExtensionName(文件名)For Each sec In aDoc.SectionsFor Each hf In sec.HeadersCall 添加图片水印(hf, 水印图片路径)Next
Next
aDoc.SaveAs2 FileName:=fNewName, FileFormat:=aDoc.SaveFormat
aDoc.Close wdSaveChangesSet aDoc = Nothing
Set fso = Nothing
End Sub
Sub 添加图片水印(hf As HeaderFooter, 水印图片路径 As String)
Dim 线型 As Long线型 = hf.Range.ParagraphFormat.Borders.InsideLineStyle
hf.Shapes.AddPicture(FileName:=水印图片路径, LinkToFile:=False, SaveWithDocument:=True).Select
With Selection.ShapeRange
.PictureFormat.Brightness = 0.5
.PictureFormat.Contrast = 0.5
.LockAspectRatio = True
.Height = CentimetersToPoints(24.25)
.Width = CentimetersToPoints(15.48)
.WrapFormat.AllowOverlap = True
.WrapFormat.Side = wdWrapNone
.WrapFormat.Type = 3
.RelativeHorizontalPosition = _wdRelativeVerticalPositionMargin
.RelativeVerticalPosition = _wdRelativeVerticalPositionMargin
.Left = wdShapeCenter
.Top = wdShapeCenter
End With
hf.Range.ParagraphFormat.Borders.InsideLineStyle = 线型
End Sub

利用VBA给文档批量添加水印相关推荐

怎么同时给多个 PDF 文档批量添加自定义的文字和图片水印
概要:为了信息安全和版权保护,给 PDF 文档添加水印是非常重要且必要的.现在很多 PDF 的阅读器都带了添加水印的功能,能给实现给单个的 PDF 文档添加水印.但如果需要批量的给一些 PDF 添加水 ...
jacob.jar 操作word文件添加水印、图片（附查阅Microsoft Office VBA参考文档方式）
jacob.jar 操作word文件添加水印.图片 1.准备jacob.jar包和dll文件将jacob.jar引入到工程, 64位: 将jacob-1.17-M2-x64.dll 放在C:\Wi ...
word文档批量转换为html格式
有时需要将doc/docx格式的文档批量转换为html格式的网页文件,可以使用以下VBA脚本执行批量转换的操作,需要在安装了宏功能的Word中执行. 以下脚本会搜索指定目录中的doc文档,并逐个进行处 ...
揭秘新推广渠道:：利用腾讯文档做QQ消息弹窗
圈内营销大佬推广又搞出了新路子,利用腾讯文档做QQ微信消息弹窗推广,折腾出了一种新的推广方式! 在之前,很多站长估计之前都没有仔细观察注腾讯文档这个产品,都是用来在线编辑文档办公用,很多人没想到是,最 ...
批量处理word文件内容_word文档批量处理大师
优秀的资源工具可以让你事半功倍! 资源下载请回复 "领取资源" 自助领取. word文档批量处理大师软件精致,简单易用,针对性强,是特别针对Office办公软件中的Word文档 ...
亿愿Word文档批量多语言翻译---word文档翻译专家！几十种语言随意快速互译！可以生成中外文，中英文对照内容文档！
亿愿Word文档批量多语言翻译-软件功能简介 [亿愿Word文档批量多语言翻译]采用目前最强大的.国际著名公司的谷歌翻译引擎,自动识别语言种类,把英文.日文.韩文.德文.法文.俄文等几十种外国语言的文 ...
如何利用 onlyoffice 实现文档格式转换
目录前言正文启动 onlyoffice 服务 API 接口介绍转换列表请求示例结尾前言日常生活和工作中,文档格式转换应该是很常见的需求.面对这样的需求,我们技术男有没有属于自己的好方法 ...
如何在 Word 文档中添加水印？
把 Word 文档中的文件直接发送给客户或者其他人时,难免可能会被直接复制,引起不要的安全隐患.因此,在 Word 当中,通常是可以直接导出为 PDF 文档的.为了降低内容被盗取的可能性,有时候我们还 ...
如何将多个 Docx 格式 Word 文档批量转为 Doc 格式
概要:前面我们介绍过常见的 Word 文档有多种格式,比如 Doc.Docx,并且详细介绍了如何批量将多个 Doc 格式的 Word 文档批量转为 Docx 格式文档,相信对大家都有一些的帮助.那 D ...

利用VBA给文档批量添加水印

利用VBA给文档批量添加水印相关推荐

最新文章

热门文章