在 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
我正在寻找一种在 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