Title: Use VBA code to add and remove a watermark on all pages in a Word document

This post shows one way that you can add and remove a watermark in a Word document. To add a watermark in this way, you add a "building block" to the header of each of the document's sections. If headers are marked so the first page is different or if odd and even pages have different watermarks, then you need to add the watermark to each separately. All of that can be a lot of work, so I wrote this example to add and remove watermarks from every section in the document.

The following code adds a watermark to each page.

Sub AddWatermarks() Dim doc As Document Dim sec As Section Dim hdr As HeaderFooter Dim rng As Range Dim strBBPath As String ' Building block names. Const confidential_1 As String = "CONFIDENTIAL 1" Const confidential_2 As String = "CONFIDENTIAL 2" Const do_not_copy_1 As String = "DO NOT COPY 1" Const do_not_copy_2 As String = "DO NOT COPY 2" Const draft_1 As String = "DRAFT 1" Const draft_2 As String = "DRAFT 2" Const sample_1 As String = "SAMPLE 1" ' Where to find the building blocks. strBBPath = "C:\Users\" & (Environ$("Username")) & _ "\AppData\Roaming\Microsoft\Document Building " & _ "Blocks\1033\14\Built-In Building Blocks.dotx" ' Loop through the sections. Set doc = ActiveDocument For Each sec In doc.Sections ' Loop through the section's headers. For Each hdr In sec.Headers ' Set rng to the end of the header. Set rng = hdr.Range rng.Start = rng.End ' Insert the desired building block. Application.Templates(strBBPath). _ BuildingBlockEntries(confidential_1).Insert _ Where:=rng, RichText:=True Next hdr Next sec ' Uncomment if it's a big file and ' you want to know when it's done. 'MsgBox "Done" End Sub

This code declares some variables and then defines strings to identify the six standard watermark types. It then loops through the document's sections. For each section, it loops through the section's headers. It creates a Range representing the end of the header and adds the desired building block to it.

If the document is long, this can take a while, so the code finishes by displaying a message box to let you know that it is done.

The following code removes watermarks from the active Word document.

' Remove watermarks from the active document. Sub RemoveWatermarks() Dim sec As Section For Each sec In ActiveDocument.Sections RemoveWatermarksFromRange sec.Headers(wdHeaderFooterFirstPage).Range RemoveWatermarksFromRange sec.Headers(wdHeaderFooterPrimary).Range RemoveWatermarksFromRange sec.Headers(wdHeaderFooterEvenPages).Range Next sec End Sub

This subroutine loops through the document's sections and calls the following RemoveWatermarksFromRange subroutine for each of the three kinds of headers for each section.

' Remove shapes that have a name containing the ' string PowerPlusWaterMarkObject from this range. Sub RemoveWatermarksFromRange(rng As Range) Dim shape_range As Shape For Each shape_range In rng.ShapeRange If (InStr(shape_range.Name, "PowerPlusWaterMarkObject") > 0) Then shape_range.Delete End If Next shape_range End Sub

This code loops through the range's shapes. If a shape has a name that contains the string "PowerPlusWaterMarkObject," then it is a watermark so the code deletes it.

Note that this code worked for me, but I have not tested it extensively. I recommend that you make a copy of your document before you run the code on it, just in case something goes wrong.

I didn't need a custom watermark, so this code does not deal with those. If you write code to add and remove custom watermarks, or if you make other changes that you think might help someone else, please let me know.

Download the example to experiment with it and to see additional details.