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

Question

我正在处理一些代码，它使用 Excel 文件中的数据修改 Word 文档模板（代码在 Excel 中运行）。 此代码在 Word 中创建并保存多个自定义字母，一切正常。 我现在正在尝试获取将水印添加到其中一些字母中的代码（请注意，带有水印的特定字母每次运行都会有所不同），这是我遇到的问题。

这是 Excel 的代码片段，我从 Word 中的宏记录中得出，用于创建自定义水印。

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 object model 特定代码的枚举。

如果我需要在上面进一步澄清任何内容，请告诉我。

谢谢，

Answer 1

宏记录器使用选择 object，在广义宏中速度慢且不可靠。 这是您的代码简化为使用 Range object 和 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