目錄

一、新建文檔、錄制宏

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文件添加水印的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。