Microsoft Office Forums - View Single Post - Word 2016/365 Nightmare with Watermarks

steve_lemon · 03-03-2018, 12:33 PM

I've been having a nightmare trying to apply a watermark to a word document via a VBA Macro.

It shouldn't be a difficult thing to achieve, but this has proved really challenging. To add insult to injury, this works fine if you save your Word Document/Template in compatibility mode, so it seems something has changed with the new version of Word when it comes to applying Watermarks.

I will provide the code below, but just before I will explain briefly how the document is setup, as I feel this has something to do with the problem, but like I said this works in compatibility mode, so why not for the modern format.

The document has a different first page Header, and it uses Mirror Margins. When you use the inbuilt water mark feature it only applies it to the first page. When you VBA it to ensure it applies to all pages in the document, on page 1 it is perfect. On page 2 the watermark hangs off the left-hand side of the page (can only see some of the watermark), and on the Page 3 (or odd pages) it hangs off the right-hand page. All my attempts to correct the positioning during the macro have failed.

Why is this such a nightmare and what am I doing wrong with this code?

Code:

With ActiveDocument
  'Add watermark to each header in the first section
  With .Sections.First
    i = 0
  
    For Each myHeader In .Headers
      
      'Check we have a valid header record object to avoid run-time error
      If myHeader.Exists Then
        Set myShape = myHeader.Shapes.AddTextEffect(0, "DRAFT", "Times New Roman", 144, False, False, 0, 0)
  
        With myShape
          i = i + 1
          .Name = "Draft" & CStr(i)
          .TextEffect.NormalizedHeight = False
          .Line.Visible = False
          .Fill.Visible = True
          .Fill.Solid
          .Fill.ForeColor.RGB = RGB(192, 192, 192)
          .Fill.Transparency = 0
          .Rotation = 315
          .LockAspectRatio = True
          .Height = CentimetersToPoints(5.69)
          .Width = CentimetersToPoints(16.67)
          .WrapFormat.AllowOverlap = True
          .WrapFormat.Side = wdWrapNone
          .WrapFormat.Type = 3
          .RelativeHorizontalPosition = wdRelativeVerticalPositionMargin
          .RelativeVerticalPosition = wdRelativeVerticalPositionMargin
          .Left = wdShapeCenter
          .Top = wdShapeCenter
        End With
  
        .Range.FormattedText.ShowAll = False
      End If
    
    Next myHeader
  End With
  
  With .ActiveWindow.View
    .ShowMarkupAreaHighlight = False
    .ShowComments = False
    .ShowRevisionsAndComments = False
  End With
  
  .FormattingShowClear = True
End With

Any advice or verification that this isn't normal and the behaviors have changed gratefully received.

Steve