目錄

一、新建文檔、錄制宏

1.圖片水印

（1）錄制的宏代碼

（2）分析

2.文字水印

（1）錄制的代碼

（2）分析

二、思路分享

1.從頭開始

2.統(tǒng)一為插入圖片

三、示例代碼

1.準(zhǔn)備

2.代碼

---

因?yàn)槠綍r(shí)幾乎用不到添加水印的功能，所以對(duì)于我來說，也需要錄制宏先分析一下。下面是思路：

本文所討論的是Word自帶的水印功能。此功能可以通過【設(shè)計(jì)】選項(xiàng)卡-【頁(yè)面背景】-【水印】找到。

Word水印功能導(dǎo)航

一、新建文檔、錄制宏

Word水印功能里面具體有的【圖片水印】和【文字水印】?jī)煞N：

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）分析

代碼功能

代碼的核心是要在每節(jié)的頁(yè)眉/頁(yè)腳插入一個(gè)圖片，而我們?cè)诓迦霑r(shí)設(shè)置的其他參數(shù)如透明度都是在插入圖片后的代碼里體現(xiàn)的。

圖片水印添加步驟及效果

（3）圖片水印的實(shí)質(zhì)

我們雙擊進(jìn)入已經(jīng)添加水印的節(jié)的頁(yè)眉，然后點(diǎn)擊圖片，從【圖片格式】菜單里查看屬性，可以知道：

A.該水印圖片是一幅襯于文字下方的

B.設(shè)置過亮度、對(duì)比度等參數(shù)的圖片

這些參數(shù)設(shè)置在錄制的代碼里都能清楚地看到。

由此可以總結(jié)：圖片水印實(shí)質(zhì)上是往頁(yè)眉/頁(yè)腳中添加一張經(jīng)過處理過和圖片。

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, "樣稿 嚴(yán)禁復(fù)制", "黑體", 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）分析

刪除圖片水印

開頭這些代碼主要是刪除頁(yè)眉中第一次添加的圖片水印

核心：添加藝術(shù)字形狀

核心語句是這塊代碼在這一節(jié)的頁(yè)眉處用【AddTextEffect】方法，將藝術(shù)字形狀添加進(jìn)去。

官網(wǎng)說明示例

通過微軟官方的說明示例也能再次得到印證：文字水印從根本或者根源上講，是往頁(yè)眉或頁(yè)腳中添加形狀，而且這個(gè)形狀是一個(gè)特殊的【藝術(shù)字形狀】。

而后面其他代碼都是在設(shè)置上面添加的藝術(shù)字形狀的其他參數(shù)比如亮度、透明度等等。

二、思路分享

從前面分析可以知道，Word里添加水印，就是在文檔每節(jié)的頁(yè)眉/頁(yè)腳插入圖片或藝術(shù)字形狀。

那么大致有兩種思路：

1.從頭開始

代碼中每次從頭開始選擇圖片進(jìn)行處理或每次重新添加藝術(shù)字形狀及設(shè)置好其各種效果。

文字藝術(shù)字參數(shù)展示1

文字藝術(shù)字參數(shù)展示2

但是這種方法設(shè)計(jì)程序，要么需要使用者自己調(diào)整代碼，就算用InputBox()等方式讓用戶傳遞參數(shù)，用戶也不能提前預(yù)覽效果。所以對(duì)于編寫簡(jiǎn)單上手的程序不推薦此方法

2.統(tǒng)一為插入圖片

將圖片或藝術(shù)字效果提前統(tǒng)一設(shè)置為圖片，這樣使用都批量插入時(shí)參數(shù)就越少。

因?yàn)椴皇亲鐾昝赖牟寮?#xff0c;是做一個(gè)馬上可以上手用，而且操作簡(jiǎn)便的小程序。所以，我推薦用這種方式，只需要選擇存放Word文件的主文件夾或者選擇多個(gè)文件，就可以馬上完成工作。

三、示例代碼

這里主要是以【統(tǒng)一插入圖片】的方法，設(shè)計(jì)的簡(jiǎn)單程序

1.準(zhǔn)備

使用者的準(zhǔn)備工作：提前將水印效果的圖片處理好（用Word、PPT、PS都可以）

2.代碼

Rem 這里是主程序 Sub 批量獲取文件路徑()Dim fd As FileDialogDim fso As ObjectDim arr() '存儲(chǔ)每次遍歷到的文件夾的子文件夾Dim brr() '臨時(shí)存儲(chǔ)每次遍歷到的文件夾的子文件夾Dim crr() '存儲(chǔ)所有文件夾Dim drr() '存儲(chǔ)所有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 此處以下為調(diào)用的處理過程Application.ScreenUpdating = FalseCall 遍歷節(jié)(drr(j), 水印圖片路徑)Application.ScreenUpdating = TrueRem 此處以上為調(diào)用的處理過程Debug.Print Format(j, String(Len(CStr(UBound(drr))), "0")), drr(j), "添加水印完成"NextEnd IfEnd WithSet fd = NothingSet fso = NothingSet myFolder = NothingDebug.Print "完成 共對(duì)" & UBound(drr) & "個(gè)文件添加了水印 用時(shí)" & Timer - t0 & "秒" End Sub Sub 遍歷節(jié)(文件名, 水印圖片路徑 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

總結(jié)

以上是生活随笔為你收集整理的Word VBA：批量给Word文件添加水印的全部?jī)?nèi)容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網(wǎng)站內(nèi)容還不錯(cuò)，歡迎將生活随笔推薦給好友。