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

Question

I am working on some code which modifies a Word document template with data from an Excel file (code is run in Excel). This code creates and saves multiple customized letters in Word, which is all working. I am now trying to get the code to add watermarks into some of these letters (note the specific letters with watermarks will vary per run), which I am having issues with.

Here is the code snippet from Excel I derived from a recording of a Macro in Word for creating a custom watermark.

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

Is it possible to get this Word derived code to work in Excel or should I be taking a different approach for adding watermarks? Is it necessary to include enumerations for Word object model specific code as I have done above.

Let me know if I need to clarify anything further in the above.

Thanks,

Answer 1

The macro recorder uses the Selection object, which is slow and unreliable in a generalized macro. Here's your code streamlined to use the Range object and With statements. If your document is set up with different first page and/or even and odd headers, you will have to write variations on 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