準備

• Word文件檔案
• png or jpg圖片檔案
• Excel路徑對照表
• VBA語法

修改兩處

' 設定資料夾路徑與對照表路徑 folderPath = "C:\Users\Meiko\Desktop\Word浮水印\" ' 替換為Word檔案資料夾路徑 mappingPath = "C:\Users\Meiko\Desktop\Word浮水印\FileMapping.xlsx" ' 替換為Excel對照表路徑

Sub BatchAddWatermarkWithMapping()
    Dim folderPath As String
    Dim mappingPath As String
    Dim fileName As String
    Dim doc As Document
    Dim shape As shape
    Dim wb As Object
    Dim ws As Object
    Dim i As Long
    Dim lastRow As Long
    Dim wordFileName As String
    Dim watermarkImagePath As String
    Dim pageWidth As Single
    Dim pageHeight As Single

    ' 設定資料夾路徑與對照表路徑
    folderPath = "C:\\Users\\Meiko\\Desktop\\Word浮水印\\" ' 替換為Word檔案資料夾路徑
    mappingPath = "C:\\Users\\Meiko\\Desktop\\Word浮水印\\FileMapping.xlsx" ' 替換為Excel對照表路徑

    ' 開啟Excel檔案
    Set wb = CreateObject("Excel.Application")
    Set ws = wb.Workbooks.Open(mappingPath).Sheets(1)

    ' 獲取對照表最後一列
    lastRow = ws.Cells(ws.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp

    ' 逐行讀取對照表
    For i = 2 To lastRow ' 假設第一行為標題
        wordFileName = ws.Cells(i, 1).Value ' Word檔案名稱
        watermarkImagePath = ws.Cells(i, 2).Value ' 浮水印圖片路徑

        ' 檢查檔案是否存在
        If Dir(folderPath & wordFileName) <> "" Then
            ' 開啟Word檔案
            Set doc = Documents.Open(folderPath & wordFileName)

            ' 獲取頁面尺寸
            pageWidth = doc.PageSetup.pageWidth
            pageHeight = doc.PageSetup.pageHeight

            ' 添加浮水印圖片
            Set shape = doc.Sections(1).Headers(wdHeaderFooterPrimary).Shapes.AddPicture( _
                fileName:=watermarkImagePath, _
                LinkToFile:=False, _
                SaveWithDocument:=True)

            ' 設定浮水印位置及大小
            With shape
                .LockAspectRatio = msoTrue ' 保持圖片等比例縮放
                ' 設定圖片大小（A4大小：寬21cm，高29.7cm）
                .Width = CentimetersToPoints(21)
                .Height = CentimetersToPoints(29.7)
                ' 設定圖片位置
                .Left = CentimetersToPoints(-3.2) ' 從邊界左邊-3.2公分
                .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
                .Top = CentimetersToPoints(-1.6) ' 起始段落-1.6公分
                .RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
                ' 設定圖片為文字後方
                .WrapFormat.Type = wdWrapBehind
            End With

            ' 儲存並關閉文件
            doc.Save
            doc.Close
        Else
            MsgBox "找不到文件：" & folderPath & wordFileName, vbExclamation
        End If
    Next i

    ' 關閉Excel檔案
    wb.Workbooks.Close
    wb.Quit
    Set wb = Nothing

    MsgBox "批次添加浮水印完成！"
End Sub

範例下載

#W06-批次套印浮水印 依不同檔案，套印不同浮水印