在Excel VBA创建的Word文档中插入水印

Question

我正在编写一些代码，这些代码修改了Excel文件中包含数据的Word文档模板(代码在Excel中运行)。这段代码在Word中创建并保存了多个自定义字母，这一切都很正常。我现在正试图让代码在这些字母中添加水印(注意带有水印的特定字母每次运行都会有所不同)，这是我遇到的问题。

下面是Excel I中用于创建自定义水印的宏记录的代码片段。

Sub InsertWatermark()
Dim DocLocation As String
Dim WordDoc, WordApp As Object
Set WordApp = GetObject("Word.Application")
WordDoc = WordApp.Documents.Open(FileName:=DocLocation, ReadOnly:=False)
WordDoc.Sections(1).Range.Select
WordDoc.View.SeekView = 9 'wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes.AddTextEffect( _
PowerPlusWaterMarkObject1889500, "DRAFT", "Trebuchet MS", 1, False, False _
, 0, 0).Select
Selection.ShapeRange.Name = "PowerPlusWaterMarkObject1889500"
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.5
Selection.ShapeRange.Rotation = 315
Selection.ShapeRange.LockAspectRatio = True
Selection.ShapeRange.Height = CentimetersToPoints(6.65)
Selection.ShapeRange.Width = CentimetersToPoints(16.61)
Selection.ShapeRange.WrapFormat.AllowOverlap = True
Selection.ShapeRange.WrapFormat.Type = 3
Selection.ShapeRange.RelativeHorizontalPosition = 0 'wdRelativeVerticalPositionMargin
Selection.ShapeRange.RelativeVerticalPosition = 0 'wdRelativeVerticalPositionMargin
Selection.ShapeRange.Left = -999995 'wdShapeCenter
Selection.ShapeRange.Top = -999995 'wdShapeCenter
End Sub

是否有可能让这个Word衍生代码在Excel中工作，或者我应该采取不同的方法来添加水印?是否有必要像我上面所做的那样，为特定于Word对象模型的代码包含枚举?

如果上面还有什么需要进一步澄清的，请告诉我。

谢谢,

Answer 1

宏记录器使用Selection对象，这在通用宏中是缓慢且不可靠的。下面是精简后的代码，以使用Range对象和With语句。如果您的文档设置了不同的第一页和/或偶数和奇数标题，您将不得不在wdHeaderFooterPrimary上编写变体:

Sub InsertWatermark()
Dim DocLocation As String
Dim WordDoc, WordApp As Object
Dim oShape As Shape
Set WordApp = GetObject("Word.Application")
WordDoc = WordApp.Documents.Open(FileName:=DocLocation, ReadOnly:=False)
Set oShape = WordDoc.Sections(1).Headers(wdHeaderFooterPrimary) _
.Shapes.AddTextEffect(PowerPlusWaterMarkObject1889500, "DRAFT", _
"Trebuchet MS", 1, False, False, 0, 0)
With oShape
.Name = "PowerPlusWaterMarkObject1889500"
.TextEffect.NormalizedHeight = False
.Line.Visible = False
With .Fill
.Visible = True
.Solid
.ForeColor.RGB = RGB(192, 192, 192)
.Transparency = 0.5
End With
.Rotation = 315
.LockAspectRatio = True
.Height = CentimetersToPoints(6.65)
.Width = CentimetersToPoints(16.61)
With .WrapFormat
.AllowOverlap = True
.Type = 3
End With
.RelativeHorizontalPosition = 0 'wdRelativeVerticalPositionMargin
.RelativeVerticalPosition = 0 'wdRelativeVerticalPositionMargin
.Left = -999995 'wdShapeCenter
.Top = -999995 'wdShapeCenter
End With
End Sub