一、新建文档、录制宏

1.图片水印

（1）录制的宏代码

（2）分析

2.文字水印

（1）录制的代码

（2）分析

二、思路分享

1.从头开始

2.统一为插入图片

三、示例代码

1.准备

2.代码

因为平时几乎用不到添加水印的功能，所以对于我来说，也需要录制宏先分析一下。下面是思路：

本文所讨论的是Word自带的水印功能。此功能可以通过【设计】选项卡-【页面背景】-【水印】找到。

Word水印功能导航

一、新建文档、录制宏

Word水印功能里面具体有的【图片水印】和【文字水印】两种：

1.图片水印

（1）录制的宏代码

Sub 图片水印()
'
' 添加水印 宏
'
'ActiveDocument.Sections(1).Range.SelectActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeaderSelection.HeaderFooter.Shapes.AddPicture(fileName:= _"E:\图片\PS素材\jiqimao.jpg", LinkToFile:=False, SaveWithDocument:=True). _SelectSelection.ShapeRange.Name = "WordPictureWatermark47371484"Selection.ShapeRange.PictureFormat.Brightness = 0.85Selection.ShapeRange.PictureFormat.Contrast = 0.15Selection.ShapeRange.LockAspectRatio = TrueSelection.ShapeRange.Height = CentimetersToPoints(13.45)Selection.ShapeRange.Width = CentimetersToPoints(14.66)Selection.ShapeRange.WrapFormat.AllowOverlap = TrueSelection.ShapeRange.WrapFormat.Side = wdWrapNoneSelection.ShapeRange.WrapFormat.Type = 3Selection.ShapeRange.RelativeHorizontalPosition = _wdRelativeVerticalPositionMarginSelection.ShapeRange.RelativeVerticalPosition = _wdRelativeVerticalPositionMarginSelection.ShapeRange.Left = wdShapeCenterSelection.ShapeRange.Top = wdShapeCenterActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub

（2）分析

代码功能

代码的核心是要在每节的页眉/页脚插入一个图片，而我们在插入时设置的其他参数如透明度都是在插入图片后的代码里体现的。

图片水印添加步骤及效果

（3）图片水印的实质

我们双击进入已经添加水印的节的页眉，然后点击图片，从【图片格式】菜单里查看属性，可以知道：

A.该水印图片是一幅衬于文字下方的

B.设置过亮度、对比度等参数的图片

这些参数设置在录制的代码里都能清楚地看到。

由此可以总结：图片水印实质上是往页眉/页脚中添加一张经过处理过和图片。

2.文字水印

（1）录制的代码

Sub 文字水印()
'
' 文字水印 宏
'
'ActiveDocument.Sections(1).Range.SelectActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeaderSelection.HeaderFooter.Shapes("WordPictureWatermark47371484").SelectSelection.DeleteActiveWindow.ActivePane.View.SeekView = wdSeekMainDocumentActiveDocument.Sections(1).Range.SelectActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeaderSelection.HeaderFooter.Shapes.AddTextEffect( _PowerPlusWaterMarkObject47591468, "样稿 严禁复制", "黑体", 44, False, False, 0, 0 _).SelectSelection.ShapeRange.Name = "PowerPlusWaterMarkObject47591468"Selection.ShapeRange.TextEffect.NormalizedHeight = FalseSelection.ShapeRange.Line.Visible = FalseSelection.ShapeRange.Fill.Visible = TrueSelection.ShapeRange.Fill.SolidSelection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 155, 155)Selection.ShapeRange.Fill.Transparency = 0.5Selection.ShapeRange.Rotation = 315Selection.ShapeRange.LockAspectRatio = TrueSelection.ShapeRange.Height = CentimetersToPoints(1.54)Selection.ShapeRange.Width = CentimetersToPoints(10.18)Selection.ShapeRange.WrapFormat.AllowOverlap = TrueSelection.ShapeRange.WrapFormat.Side = wdWrapNoneSelection.ShapeRange.WrapFormat.Type = 3Selection.ShapeRange.RelativeHorizontalPosition = _wdRelativeVerticalPositionMarginSelection.ShapeRange.RelativeVerticalPosition = _wdRelativeVerticalPositionMarginSelection.ShapeRange.Left = wdShapeCenterSelection.ShapeRange.Top = wdShapeCenterActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub

（2）分析

删除图片水印

开头这些代码主要是删除页眉中第一次添加的图片水印

核心：添加艺术字形状

核心语句是这块代码在这一节的页眉处用【AddTextEffect】方法，将艺术字形状添加进去。

官网说明示例

通过微软官方的说明示例也能再次得到印证：文字水印从根本或者根源上讲，是往页眉或页脚中添加形状，而且这个形状是一个特殊的【艺术字形状】。

而后面其他代码都是在设置上面添加的艺术字形状的其他参数比如亮度、透明度等等。

二、思路分享

从前面分析可以知道，Word里添加水印，就是在文档每节的页眉/页脚插入图片或艺术字形状。

那么大致有两种思路：

1.从头开始

代码中每次从头开始选择图片进行处理或每次重新添加艺术字形状及设置好其各种效果。

文字艺术字参数展示1

文字艺术字参数展示2

但是这种方法设计程序，要么需要使用者自己调整代码，就算用InputBox()等方式让用户传递参数，用户也不能提前预览效果。所以对于编写简单上手的程序不推荐此方法

2.统一为插入图片

将图片或艺术字效果提前统一设置为图片，这样使用都批量插入时参数就越少。

因为不是做完美的插件，是做一个马上可以上手用，而且操作简便的小程序。所以，我推荐用这种方式，只需要选择存放Word文件的主文件夹或者选择多个文件，就可以马上完成工作。

三、示例代码

这里主要是以【统一插入图片】的方法，设计的简单程序

1.准备

使用者的准备工作：提前将水印效果的图片处理好（用Word、PPT、PS都可以）

2.代码

Rem 这里是主程序
Sub 批量获取文件路径()Dim fd As FileDialogDim fso As ObjectDim arr() '存储每次遍历到的文件夹的子文件夹Dim brr() '临时存储每次遍历到的文件夹的子文件夹Dim crr() '存储所有文件夹Dim drr() '存储所有Word文件路径Dim myFolder As ObjectDim subFolder As VariantDim i As LongDim j As LongDim m As LongDim myFile As ObjectDim 后缀 As StringDim t0 As SingleDim fd1 As FileDialogDim 水印图片路径 As Stringt0 = Timeri = 0: j = 0: m = 0Set 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 IfEnd WithSet fd = NothingSet fso = NothingSet myFolder = NothingDebug.Print "完成   共对" & UBound(drr) & "个文件添加了水印   用时" & Timer - t0 & "秒"
End Sub
Sub 遍历节(文件名, 水印图片路径 As String)Dim aDoc As DocumentDim sec As SectionDim hf As HeaderFooterDim fso As ObjectDim fName As StringDim 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, 水印图片路径)NextNextaDoc.SaveAs2 fileName:=fNewName, FileFormat:=aDoc.SaveFormataDoc.Close wdSaveChangesSet aDoc = NothingSet fso = Nothing
End Sub
Sub 添加图片水印(hf As HeaderFooter, 水印图片路径 As String)Dim 线型 As Long线型 = hf.Range.ParagraphFormat.Borders.InsideLineStylehf.Shapes.AddPicture(fileName:=水印图片路径, linktofile:=False, savewithdocument:=True).SelectWith Selection.ShapeRange.LockAspectRatio = True.WrapFormat.Side = wdWrapNone.WrapFormat.Type = wdWrapBehind.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage.RelativeVerticalPosition = wdRelativeVerticalPositionPage.Left = wdShapeCenter.Top = wdShapeCenterEnd Withhf.Range.ParagraphFormat.Borders.InsideLineStyle = 线型
End Sub

Word VBA：批量给Word文件添加水印相关推荐

如何利用VBA批量更改Excel文件的内容
心得(5):利用VBA批量更改Excel文件的内容问题:因为接受的所有Excel文件都是相同格式的,但是有个单元格的内容就是需要,主办方来更改,如下所示: 获奖级别,得由主办方来更改,但是如果一个一 ...
多个word vba批量替换文字（一个文件夹）
多个word批量替换word文字! Sub 替换N个word文档()Dim Dm As DocumentDim MyPath As StringDim MyName As StringDim N As ...
Word VBA批量格式转换：docx转pdf、doc、rtf、txt以及反向转换
有时候需要把大量的docx文件另存为其它格式,比如pdf.doc.rtf.txt,或者反向转换,可以用VBA批量处理.启动word,按下Alt+F11,打开Microsoft Visual Basic ...
python批量pdf转word,python批量实现Word文件转换为PDF文件
本文为大家分享了python批量转换Word文件为PDF文件的具体方法,供大家参考,具体内容如下 1.目的通过万能的Python把一个目录下的所有Word文件转换为PDF文件. 2.遍历目录作者总 ...
VBA批量导入CSV文件、批量改数据标题、批量做数据透视表
'本代码是利用VB批量导入CSV文件,并且每个文件存为一个Sheet '前提是所有CSV文件和运行宏的这个文件在同一个文件夹 '不智能的地方是我预先知道有多少个CSV文件,然后把文件名改为1.csv, ...
Word VBA(批量复制Excel表格和Word表格到Word中)
Function Test() '使用双字典 SearchPath = FolderDialog("请选择文件夹") If SearchPath = & ...
word 宏命令批量把当前文件夹下的doc另存为docx格式
问题与需求: 程序生成了一批doc文件,因为是模板生成的,虽然后缀是doc文件,但是有些软件识别还是hmt格式的单网页格式,所以需要另存为真正的docx格式. 实现: 最后实现为,运行当前宏命令sav ...
R语言将文件名写入word并批量合并word
问题: 有n个word文件,里面放有健康码截图,但使用人的姓名作为word的文件名出现,没有出现的文件内容中要求: 将文件名作为内容写入相应的文件中,合并所有文件解决方案 library(offi ...
使用python 将excel中数据批量生成word周报
使用python 将excel中数据调用word模板批量生成word周报背景环境功能需求程序实现背景日常项目中每周需要召开项目周会,会议纪要和会议周报是必不可少的一项内容,会议纪要要求监理 ...
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 VBA：批量给Word文件添加水印

一、新建文档、录制宏

1.图片水印

（1）录制的宏代码

（2）分析

2.文字水印

（1）录制的代码

（2）分析

二、思路分享

1.从头开始

2.统一为插入图片

三、示例代码

1.准备

2.代码

Word VBA：批量给Word文件添加水印相关推荐

最新文章

热门文章