在 Word 文档中插入水印

Insert watermark in Word Documents

我正在寻找一种在 Word 文档中插入水印的方法。这是我通过录制宏得到的代码,

Sub add_watermark()
'
' Macro2 Macro
'
'
    ActiveDocument.Sections(1).Range.Select
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    Selection.HeaderFooter.Shapes.AddTextEffect( _
        PowerPlusWaterMarkObject354239640, "PAID", "arial", 1, False, False, 0, 0 _
        ).Select
    Selection.ShapeRange.Name = "PowerPlusWaterMarkObject354239640"
    Selection.ShapeRange.TextEffect.NormalizedHeight = False
    Selection.ShapeRange.Line.Visible = False
    Selection.ShapeRange.Fill.Visible = True
    Selection.ShapeRange.Fill.Solid
    Selection.ShapeRange.Fill.ForeColor.RGB = RGB(192, 192, 192)
    Selection.ShapeRange.Fill.Transparency = 0
    Selection.ShapeRange.Rotation = 315
    Selection.ShapeRange.LockAspectRatio = True
    Selection.ShapeRange.Height = CentimetersToPoints(9.31)
    Selection.ShapeRange.Width = CentimetersToPoints(13.96)
    Selection.ShapeRange.WrapFormat.AllowOverlap = True
    Selection.ShapeRange.WrapFormat.Side = wdWrapNone
    Selection.ShapeRange.WrapFormat.Type = 3
    Selection.ShapeRange.RelativeHorizontalPosition = _
        wdRelativeVerticalPositionMargin
    Selection.ShapeRange.RelativeVerticalPosition = _
        wdRelativeVerticalPositionMargin
    Selection.ShapeRange.Left = wdShapeCenter
    Selection.ShapeRange.Top = wdShapeCenter
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub

但我在 运行 另一个文档中的宏之后出现“超出范围”错误。当我调试它时,这一行 "Selection.ShapeRange.Name = "PowerPlusWaterMarkObject354239640" 被突出显示。

有人知道怎么解决吗?

谢谢,

尝试一些基于:

Sub AddPaidWatermark()
Application.ScreenUpdating = False
Dim sWdth As Single, Shp As Shape
With ActiveDocument.Sections(1)
  With .PageSetup
    sWdth = .PageWidth - .LeftMargin - .RightMargin - .Gutter
  End With     
    With .Headers(wdHeaderFooterPrimary)
      If .Range.Characters.First.Information(wdWithInTable) = True Then
        With .Range.Tables(1)
          .Rows.Add .Rows(1)
          .Split .Rows(2)
        End With
        .Range.Tables(1).Delete
        .Range.Paragraphs(1).Range.Font.Hidden = True
      End If
      Set Shp = .Shapes.AddTextEffect(msoTextEffect1, "PAID", "Arial", 1, False, False, 0, 0)
    End With
  With Shp
    .WrapFormat.Type = wdWrapBehind
    .ZOrder msoBringToFront
    .Height = sWdth / 2 ^ 0.5
    .Width = .Height
    .Rotation = 315
    .RelativeHorizontalPosition = wdRelativeVerticalPositionMargin
    .RelativeVerticalPosition = wdRelativeVerticalPositionMargin
    .Left = wdShapeCenter
    .Top = wdShapeCenter
    With .Fill
      .Visible = True
      .Solid
      .ForeColor.RGB = RGB(192, 192, 192)
    End With
  End With
End With
Application.ScreenUpdating = True
End Sub