locked
Delete Watermark with Macro Issue RRS feed

  • Question

  • Good day,

    I have macros currently to insert a DRAFT or COPY watermarks (just text, not using an image) into document(s). I have found when removing the watermarks it is removing the image int he header

    Code:

    Sub RemoveWaterMark()
    '
    ' Remove.Watermark.Macro
    '
    '
        Dim strWMName As String
        
        On Error GoTo ErrHandler
        
        ActiveDocument.Sections(1).Range.Select
        strWMName = ActiveDocument.Sections(1).Index
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
        Selection.HeaderFooter.Shapes(strWMName).Select
        Selection.Delete
        ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
        
        Exit Sub

    Is there a way to code this macro to only remove the DRAFT or COPY that anyone can think of?

    Thursday, January 30, 2014 5:13 PM

All replies

  • A watermark is an image in the header, even a text Watermark is an image - WordArt. Your code is supposed all shapes in the header. Is your image inside a shape like a Textbox?

    When I try your code it does not run.

    If you are using a Ribbon version of Word and used Page Layout > Watermark to insert your watermark Word gives each new watermark a unique shape name. I'm not sure how. When it later inserts a different watermark, it deletes the previous one, by name.

    I do not have an answer for you but will post some interim steps as I try to figure one out. This way you can see the process rather than just the end result.

    Step 1: Use the macro recorder to get an idea of what Word is doing when it deletes a Watermark or changes one.

    Here are examples of recorded code:

    Sub DeleteWaterMark()
    '
    ' DeleteWaterMark Macro
    '
    '
        ActiveDocument.Sections(1).Range.Select
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
        Selection.HeaderFooter.Shapes("PowerPlusWaterMarkObject265849384").Select
        Selection.Delete
        ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    End Sub

    ----------------------------------------------------

    Sub InsertWaterMark2()
    '
    ' InsertWaterMark2 Macro
    '
    '
        ActiveDocument.Sections(1).Range.Select
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
        Selection.HeaderFooter.Shapes("PowerPlusWaterMarkObject266006337").Select
        Selection.ShapeRange.TextEffect.Text = "-"
        Selection.ShapeRange.TextEffect.FontSize = 1
        Selection.ShapeRange.TextEffect.FontName = "Cambria"
        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 = InchesToPoints(6.11)
        Selection.ShapeRange.Width = InchesToPoints(3.05)
        Selection.ShapeRange.WrapFormat.AllowOverlap = True
        Selection.ShapeRange.WrapFormat.Side = wdWrapNone
        Selection.ShapeRange.WrapFormat.Type = 3
        Selection.ShapeRange.RelativeHorizontalPosition = _
            wdRelativeVerticalPositionMargin
        Selection.ShapeRange.RelativeVerticalPosition = _
            wdRelativeVerticalPositionMargin
        Selection.ShapeRange.Left = wdShapeCenter
        Selection.ShapeRange.Top = wdShapeCenter
        ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    End Sub

    ----------------------------------------------------

    Sub WatermarkBlank()
    '
    ' WatermarkBlank Macro
    '
    '
        ActiveDocument.Sections(1).Range.Select
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
        Selection.HeaderFooter.Shapes("PowerPlusWaterMarkObject265849384").Select
        Selection.Delete
        ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
        Application.Templates( _
            "C:\Users\Charles K. Kenyon\AppData\Roaming\Microsoft\Document Building Blocks\1033\14\Building Blocks.dotx" _
            ).BuildingBlockEntries("Blank").Insert Where:=Selection.Range, RichText:= _
            True
    End Sub

    ----------------------------------------------------

    Sub RemoveWaterMark2()
    '
    ' RemoveWaterMark2 Macro
    '
    '
        ActiveDocument.Sections(1).Range.Select
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
        Selection.HeaderFooter.Shapes("PowerPlusWaterMarkObject266857275").Select
        Selection.Delete
        ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    End Sub

    ------------------------------------------------------------

    Additional thoughts/ideas.

    One other thing that I did was create a Watermark building block that had white text 100% transparent. The WatermarkBlank macro above is a recording of the insertion of that, which deleted the existing Watermark. Again, though, it uses a specific name. I can tell you that the name is NOT stored as a document variable.

    If you were to cycle through the names of the images looking for "PowerPlusWaterMarkObject" at the beginning of the name that would work for watermarks inserted by Word 2010.

    Can you get your code to change the transparency to 100% leaving the watermark there?

    Sorry, I don't have time to do more right now. Hope this helps some.


    Charles Kenyon Madison, WI




    • Edited by Charles Kenyon Friday, January 31, 2014 12:30 PM Add steps language
    Thursday, January 30, 2014 5:52 PM
  • Step 2: See if we can use code to tell us if we have a Watermark and what name Word has given it.

    I have written the following code which identifies a Watermark inserted in Word 2010 as a text Watermark.

    Sub ShowWaterMarkName()
        Dim strPrompt As String, strTitle As String, objButtons As MsoAlertButtonType
        Dim oShape As Shape
    '    ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary)
        ActiveDocument.Sections(1).Range.Select
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
        For Each oShape In Selection.HeaderFooter.Shapes
            strPrompt = oShape.Name
             MsgBox (strPrompt)
             If Left(strPrompt, 24) = "PowerPlusWaterMarkObject" Then
             
             MsgBox ("This is a Text Watermark")
             End If
             
             Next oShape
     

    End Sub

    I don't know that this is the type of Watermark you are dealing with nor whether it will work on other Watermarks inserted through the Word UI.

    I just checked and this works on Word 2007 text watermarks as well.

    Charles Kenyon Madison, WI





    • Edited by Charles Kenyon Friday, January 31, 2014 12:30 PM Add steps language
    Friday, January 31, 2014 1:56 AM
  • Step 3

    This is a macro that deletes a Text Watermark that was inserted by the Word UI in Word 2007 or Word 2010 (and probably Word 2013). This handles Building Block Watermarks and Custom Text watermarks.

    Sub TextWaterMarkDelete()
        '   Procedure to delete a Text watermark
        '   Written by Charles Kyle Kenyon 2014-01-30
        '   Works on Text Watermarks inserted in Word 2007 & 2010 by the UI
        '
        Dim strPrompt As String, oShape As Shape
        ActiveDocument.Sections(1).Range.Select
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
        For Each oShape In Selection.HeaderFooter.Shapes
            strPrompt = oShape.Name
    '         MsgBox (strPrompt)
             If Left(strPrompt, 24) = "PowerPlusWaterMarkObject" Then
                oShape.Delete
    '         MsgBox ("This is a Text Watermark")
             End If
             
             Next oShape
    End Sub

    Hope this helps. If it does, please post something to let us know. This code could certainly be improved by using a Range rather than the Selection object.


    Charles Kenyon Madison, WI



    Friday, January 31, 2014 2:26 AM
  • Step 4: Use Range Instead of Selection

    I asked for help on another forum and received the following code:

    Sub ScratchMacro()
    'A basic Word macro coded by Greg Maxey
    Dim oShp As Shape
    Dim oRng As Word.Range
    Dim i As Long
      For i = 1 To 3
        Set oRng = ActiveDocument.Sections(1).Headers(1).Range
        For Each oShp In oRng.ShapeRange
          If Left(oShp.Name, 24) = "PowerPlusWaterMarkObject" Then
            oShp.Delete
          End If
       Next oShp
     Next i
    End Sub

    This uses a Range rather than the Seliction. Among other things, it means that the insertion point doesn't get jerked around and the Text Watermark is deleted directly without selecting it. Thanks to Greg Maxey.

    Microsoft Word Help, Tips and Tutorials @ The Anchorage


    Charles Kenyon Madison, WI


    Friday, January 31, 2014 4:53 PM
  • I have tested this and what I have found if I use a standard watermark it removed it but if I use a custom (draft for instance) it does not, nor if I insert one with a macro

     

    Example code for insert:

     

    Sub DRAFTWaterMark()
    '
    ' Draft.Watermark.Macro
    '
    '
        Dim strWMName As String
        
        On Error GoTo ErrHandler
        ActiveDocument.Sections(1).Range.Select
        strWMName = ActiveDocument.Sections(1).Index
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
           Selection.HeaderFooter.Shapes.AddTextEffect(msoTextEffect1, _
        "DRAFT", "Arial", 1, False, False, 0, 0).Select
        With Selection.ShapeRange
            
            .Name = strWMName
            .TextEffect.NormalizedHeight = False
            .Line.Visible = False
            
            With .Fill
                
                .Visible = True
                .Solid
                .ForeColor.RGB = Gray
                .Transparency = 0.5
            End With
            
            .Rotation = 315
            .LockAspectRatio = True
            .Height = InchesToPoints(2.42)
            .Width = InchesToPoints(6.04)
            
            With .WrapFormat
                .AllowOverlap = True
                .Side = wdWrapNone
                .Type = 3
                
            End With
            
            .RelativeHorizontalPosition = wdRelativeVerticalPositionMargin
            .RelativeVerticalPosition = wdRelativeVerticalPositionMargin
            
            
            .Left = wdShapeCenter
            .Top = wdShapeCenter
        End With
        
        ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
        
        Exit Sub
        
    ErrHandler:
        MsgBox "An error occured trying to insert the watermark." & Chr(13) & _
        "Error Number: " & Err.Number & Chr(13) & _
        "Decription: " & Err.Description, vbOKOnly + vbCritical, "Error"
        
        
    End Sub

    Friday, January 31, 2014 7:54 PM
  • As a workaround, which may or may not be practical, you can have the macro delete all shapes in the header and then re-insert anything that should actually be there when editing is complete.


    Stefan Blom, Microsoft Word MVP

    Friday, January 31, 2014 8:14 PM
  • Step 5: The macros I posted will delete any text WaterMark inserted using the UI Insert > Watermark.

    I believe you are using WordArt.

    Here is a macro that uses that interface to insert a DRAFT watermark.

    Sub InsertDraftWatermark()
    '
    ' InsertDraftWatermark Macro
    '
    '
        ActiveDocument.Sections(1).Range.Select
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
        Selection.HeaderFooter.Shapes.AddTextEffect( _
            PowerPlusWaterMarkObject363757546, "DRAFT", "Arial", 1, False, _
            False, 0, 0).Select
        Selection.ShapeRange.Name = "PowerPlusWaterMarkObject363757546"
        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 = InchesToPoints(2.62)
        Selection.ShapeRange.Width = InchesToPoints(6.55)
        Selection.ShapeRange.WrapFormat.AllowOverlap = True
        Selection.ShapeRange.WrapFormat.Side = wdWrapNone
        Selection.ShapeRange.WrapFormat.Type = 3
        Selection.ShapeRange.RelativeHorizontalPosition = _
            wdRelativeVerticalPositionMargin
        Selection.ShapeRange.RelativeVerticalPosition = _
            wdRelativeVerticalPositionMargin
        Selection.ShapeRange.Left = wdShapeCenter
        Selection.ShapeRange.Top = wdShapeCenter
        ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    End Sub

    That was recorded. If it is used it will insert a DRAFT watermark that is deleted by the other macros. Again, these are for Ribbon versions of Word.

    Which version of Word are you using?

    Charles Kenyon Madison, WI


    Friday, January 31, 2014 8:35 PM
  •  

    Charles,

     

    I tested your recorded Macro and got a compile error 'variable not defined' on 'PowerPlusWaterMarkObject363757546'

     

    there is nothing saying I would have to use the Word Art routine, it was the only way I knew of to get the Words in it over an image. If you have an alternative i'm all ears.

    Friday, January 31, 2014 8:44 PM
  • Which version of Word are you using?

    Charles Kenyon Madison, WI

    Saturday, February 1, 2014 1:21 AM
  • Step 6: Modified macro to insert

    Try the following instead. I shortened up the PowerPlusWatermarkObject designation by deleting the number.

    Sub InsertDraftWatermark2()
    '
    ' InsertDraftWatermark Macro
    '   Tested and works in Word 2003, Word 2007, Word 2013
    '   Written from recorded macro by Charles Kyle Kenyon
    '   1 February 2014
    '
        ActiveDocument.Sections(1).Range.Select
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
        Selection.HeaderFooter.Shapes.AddTextEffect( _
            PowerPlusWaterMarkObject, "DRAFT", "Arial", 1, False, _
            False, 0, 0).Select
        With Selection.ShapeRange
            .Name = "PowerPlusWaterMarkObject"
            .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 = InchesToPoints(2.62)
            .Width = InchesToPoints(6.55)
            .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

    In Word 97 this throws an error on the .WrapFormat lines.


    Charles Kenyon Madison, WI


    Saturday, February 1, 2014 4:10 PM
  • Charles,

    this is a Word 2007 rollout. I tested and got a compile error: "Variable not Defined" error on "PowerPlusWaterMarkObject"

    Monday, February 3, 2014 3:56 PM
  • Sorry. That is the best I can do. It runs on Word 2003, Word 2007, and Word 2010 here.

    Did you copy and paste the macro or retype it?

    I do not understand your original code.

    ActiveDocument.Sections(1).Index

    should not give a string but a number. Your variable strWMName will have the number of the section rather than the name of a watermark. When I run it its value is "1" and is probably the string "1" because of the declaration.


    Charles Kenyon Madison, WI

    Tuesday, February 4, 2014 12:52 AM