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

如何解决将水印插入从 Excel VBA 创建的 Word 文档中

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

这是我在 Word 中录制的用于创建自定义水印的宏的 Excel 代码片段。

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).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 对象模型特定代码的枚举。

如果我需要进一步澄清上述内容，请告诉我。

谢谢，

解决方法

宏记录器使用 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,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