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
Tags: Microsoft Word, VB, VBA, Watermark