Archive for the ‘Microsoft’ Category

How to add and delete a watermark using VBA

Tuesday, January 27th, 2009

The following two code snippets can be used to add and remove a watermark using VBA. It has been tested in Word 2003 and 2007 and seems to work fine.

Add a watermark

The code below inserts a “DRAFT” watermark diagonally across the page.

Sub AddTheWatermark()
  ActiveDocument.Sections(1).Range.Select
  ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
  Selection.HeaderFooter.Shapes.AddTextEffect( _
      PowerPlusWaterMarkObject68660062, "DRAFT", "Arial", 1, False, False, 0, 0 _
      ).Select
  With Selection.ShapeRange
    .Name = "PowerPlusWaterMarkObject68660062"
    .TextEffect.NormalizedHeight = False
    .Line.Visible = False
    .Fill.Visible = True
    .Fill.Solid
    .Fill.ForeColor.RGB = RGB(192, 192, 192)
    .Fill.Transparency = 0.5
    .Rotation = 315
    .LockAspectRatio = True
    .Height = CentimetersToPoints(6.41)
    .Width = CentimetersToPoints(16.03)
    .WrapFormat.AllowOverlap = True
    .WrapFormat.Side = wdWrapNone
    .WrapFormat.Type = 3
    .RelativeHorizontalPosition = _
      wdRelativeVerticalPositionMargin
    .RelativeVerticalPosition = _
      wdRelativeVerticalPositionMargin
    .Left = wdShapeCenter
    .Top = wdShapeCenter
  End With
  ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub

Delete a watermark

The code below deletes all watermark objects in the active document.

Sub DeleteTheWatermark()
 
  ActiveDocument.Sections(1).Range.Select
  ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader   
  Dim shapes_to_delete As New Collection
 
  For i = 1 To Selection.HeaderFooter.Shapes.Count
    If InStr(Selection.HeaderFooter.Shapes(i).Name, "PowerPlusWaterMarkObject") > 0 Then
      shapes_to_delete.Add (Selection.HeaderFooter.Shapes(i).Name)
    End If
  Next i
 
  For Each s In shapes_to_delete
    Selection.HeaderFooter.Shapes(s).Select
    Selection.Delete
  Next s
 
  ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub