Page 1 of 2 12 LastLast
Results 1 to 15 of 21
  1. #1
    New Lounger
    Join Date
    Oct 2002
    Location
    Florida, USA
    Posts
    13
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Watermark questions (2000 SR-1)

    I've written the following code to put a watermark on every page of a document:

    - - - - - - - - - - code start - - - - - - - - - -
    Sub AddWatermark()
    Dim sect As Section
    Dim sText As String

    sText = InputBox( _
    Prompt:="Enter a string for the watermark", _
    Title:="Watermark", _
    Default:="D R A F T")
    If sText = "" Then Exit Sub
    With ActiveDocument
    For Each sect In .Sections
    <font color=blue> If sect.PageSetup.DifferentFirstPageHeaderFooter = True Then
    AddWatermarkToHeaderFooter sect, sect.Footers(wdHeaderFooterFirstPage), sText
    End If
    If sect.PageSetup.OddAndEvenPagesHeaderFooter = True Then
    AddWatermarkToHeaderFooter sect, sect.Footers(wdHeaderFooterEvenPages), sText
    End If
    AddWatermarkToHeaderFooter sect, sect.Footers(wdHeaderFooterPrimary), sText</font color=blue>
    Next sect
    End With
    End Sub

    Private Sub AddWatermarkToHeaderFooter(sect As Section, hdrftr As HeaderFooter, sText As String)
    Dim oShape As Shape

    If hdrftr.Shapes.Count > 0 Then
    If MsgBox( _
    Prompt:="Do you wish me to replace the existing shapes with a watermark?", _
    Buttons:=vbQuestion + vbYesNo, _
    Title:="Watermark") = vbNo Then Exit Sub
    End If
    For Each oShape In hdrftr.Shapes
    oShape.Delete
    Next oShape
    Set oShape = hdrftr.Shapes.AddTextEffect( _
    PresetTextEffect:=msoTextEffect2, _
    Text:=sText, _
    FontName:="Times New Roman", _
    FontSize:=96, _
    FontBold:=msoTrue, _
    FontItalic:=msoFalse, _
    Left:=0, _
    Top:=0)
    oShape.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    oShape.Left = (sect.PageSetup.PageWidth - oShape.Width) 2
    oShape.Top = (sect.PageSetup.PageHeight - oShape.Height) 2
    oShape.Fill.ForeColor.RGB = RGB(240, 240, 240)
    End Sub
    - - - - - - - - - - code end - - - - - - - - - -

    And it works rather nicely except when the document has different headers/footers for the first page and/or odd and even pages selected in page setup:

    Neither box selected: Doc has a watermark on all pages.
    Different first page selected: Watermark is on every page except the first.
    Different odd and even selected: Watermark is only on every odd page.
    Both selected: Watermarks appear on ever odd page starting with page 3.

    I see the pattern in here, and I attempted to code for it above, without success. As far as I can tell, there seems to be no difference which footer I select to use (using the wdHeaderFooterFirstPage/wdHeaderFooterEvenPages/wdHeaderFooterPrimary parameters), since all of them put the watermark in the same location in the document anyway.
    The entire blue section of my code above could have been replaced with just the last line of it!

    I'm stumped. How can I assure that a watermark appears on ALL pages of a document?

    Steven

  2. #2
    Plutonium Lounger
    Join Date
    Nov 2001
    Posts
    10,550
    Thanks
    0
    Thanked 7 Times in 7 Posts

    Re: Watermark questions (2000 SR-1)

    This code should visit every header in your document...

    Sub WMarkTest()
    Dim secSection As Section
    Dim hfHeader As HeaderFooter

    For Each secSection In ActiveDocument.Sections
    For Each hfHeader In secSection.Headers
    If Not hfHeader.LinkToPrevious Then
    ' Put your code here
    End If
    Next hfHeader
    Next secSection
    End Sub

    StuartR

  3. #3
    New Lounger
    Join Date
    Oct 2002
    Location
    Florida, USA
    Posts
    13
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Watermark questions (2000 SR-1)

    Nope. Does not make a difference

    Unless I missed something, .LinkToPrevious allows me to ignore subsequent sections that use the same header/footer easier, but doesn't address the issue with the problem that I am having.

  4. #4
    New Lounger
    Join Date
    Oct 2002
    Location
    Florida, USA
    Posts
    13
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Watermark questions (2000 SR-1)

    Actually it hides an even sillier thing: it seems the Headers collection in Word always returns 3 elements for each section, regardless of whether you have selected the odd/even or first page different choices. They all are the same header, though.

    This means that in order to prevent duplicate work, you would HAVE to test the settings in the PageSetup object to know whether to ignore a particular header.

  5. #5
    Plutonium Lounger
    Join Date
    Nov 2001
    Posts
    10,550
    Thanks
    0
    Thanked 7 Times in 7 Posts

    Re: Watermark questions (2000 SR-1)

    I find it hard to believe that this doesn't make a difference. I copied it from my own "Add Watermark" macro where it works perfectly.

    If you replace the comment in my code with something that adds your watermark to the current header then all headers will have your watermark in them. The link to previous check is to prevent you adding the watermark to a header that already has one.

    StuartR

  6. #6
    New Lounger
    Join Date
    Oct 2002
    Location
    Florida, USA
    Posts
    13
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Watermark questions (2000 SR-1)

    Ok -- I am reposting my code with the change that you specified:

    -------------------------------------------------------------------
    Sub AddWatermarkTest()
    Dim sect As Section
    Dim sText As String
    Dim hf As HeaderFooter

    sText = InputBox( _
    Prompt:="Enter a string for the watermark", _
    Title:="Watermark", _
    Default:="D R A F T")
    If sText = "" Then Exit Sub
    For Each sect In ActiveDocument.Sections
    For Each hf In sect.Headers
    If Not hf.LinkToPrevious Then AddWatermarkToHeaderFooter sect, hf, sText
    Next hf
    Next sect
    End Sub

    Private Sub AddWatermarkToHeaderFooter(sect As Section, hf As HeaderFooter, sText As String)
    Dim oShape As Shape

    If hf.LinkToPrevious Then Exit Sub
    If hf.Shapes.Count > 0 Then
    If MsgBox( _
    Prompt:="Do you wish me to replace the existing shapes with a watermark?", _
    Buttons:=vbQuestion + vbYesNo, _
    Title:="Watermark") = vbNo Then Exit Sub
    End If
    For Each oShape In hf.Shapes
    oShape.Delete
    Next oShape
    Set oShape = hf.Shapes.AddTextEffect( _
    PresetTextEffect:=msoTextEffect2, _
    Text:=sText, _
    FontName:="Times New Roman", _
    FontSize:=96, _
    FontBold:=msoTrue, _
    FontItalic:=msoFalse, _
    Left:=0, _
    Top:=0)
    oShape.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    oShape.RelativeVerticalPosition = wdRelativeVerticalPositionPage
    oShape.Left = (sect.PageSetup.PageWidth - oShape.Width) 2
    oShape.Top = (sect.PageSetup.PageHeight - oShape.Height) 2
    oShape.Fill.ForeColor.RGB = RGB(240, 240, 240)
    End Sub
    -----------------------------------------------------------

    Maybe there is something wrong with my machine, or we are on different versions of Word, or whatever, but if you could take this code, put it into a new blank document that is 3 pages long, set the PageSetup values to have different odd/even and first page headers and footers, and run the AddWatermarkTest subroutine.

    On my machine, I only get a watermark on page 3. If I uncheck those settings, I get it on all of them. Let me know if I need to reinstall Word <img src=/S/crossfingers.gif border=0 alt=crossfingers width=17 height=16>

  7. #7
    Plutonium Lounger
    Join Date
    Nov 2001
    Posts
    10,550
    Thanks
    0
    Thanked 7 Times in 7 Posts

    Re: Watermark questions (2000 SR-1)

    I think that your problem is the lines

    For Each oShape In hf.Shapes
    oShape.Delete
    Next oShape

    I have a feeling that Word only has a single shapes collection for all headers.

    Similarly the call to hf.Shapes.AddTextEffect needs to specify an Anchor of hf.Range.Paragraphs(1) or something similar, otherwise the graphic won't be anchored to the correct header.

    I added the line
    If Not hf.LinkToPrevious Then hf.Range.InsertAfter "Hello World"
    Immediately after your line
    If Not hf.LinkToPrevious Then AddWatermarkToHeaderFooter sect, hf, sText
    and I saw the "Hello World" text appeared in all the headers.

    StuartR

  8. #8
    Super Moderator
    Join Date
    Jan 2001
    Location
    Melbourne, Victoria, Australia
    Posts
    3,852
    Thanks
    4
    Thanked 259 Times in 239 Posts

    Re: Watermark questions (2000 SR-1)

    I have done this by using the selection object and starting from the top of the document and using NextHeaderFooter until it errors (ie we are now in the last section). I couldn't find out how to figure out what the last headerfooter was in any simpler way.

    To cope with the same as previous even when the previous was absent from view in the earlier section, I placed a bookmark in with the watermark. If the bookmark was present in the next section then the watermark was already there.

    From looking at your code - I am wondering why you delete the previous shapes on every pass of the loop. This is going to remove any watermark you just added. Try running that part of the code up front before entering the loop. I would recommend you run it even before you ask for the watermark string. After all there is not much point in asking for the string if the user is going to answer No to the next question.
    Andrew Lockton, Chrysalis Design, Melbourne Australia

  9. #9
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Watermark questions (2000 SR-1)

    I think I found the cause of your problem: the headers of a section share a single Shapes collection, so you are erasing your own tracks. You need to erase existing shapes once for each section instead of for each header in that section. And you need to select each header in turn, otherwise the shapes are all created in the first header. Here is code that works for me:

    Sub AddWatermarkTest()
    Dim sect As Section
    Dim sText As String
    Dim hf As HeaderFooter
    Dim oShape As Shape

    sText = InputBox( _
    Prompt:="Enter a string for the watermark", _
    Title:="Watermark", _
    Default:="D R A F T")
    If sText = "" Then Exit Sub
    For Each sect In ActiveDocument.Sections
    If sect.Headers(wdHeaderFooterPrimary).Shapes.Count > 0 Then
    If MsgBox( _
    Prompt:="Do you wish me to replace the existing shapes with a watermark?", _
    Buttons:=vbQuestion + vbYesNo, _
    Title:="Watermark") = vbNo Then Exit Sub
    For Each oShape In sect.Headers(wdHeaderFooterPrimary).Shapes
    oShape.Delete
    Next oShape
    End If
    For Each hf In sect.Headers
    If Not hf.LinkToPrevious Then AddWatermarkToHeaderFooter sect, hf, sText
    Next hf
    Next sect
    End Sub

    Private Sub AddWatermarkToHeaderFooter(sect As Section, hf As HeaderFooter, sText As String)
    If hf.LinkToPrevious Then Exit Sub
    hf.Range.Select
    With hf.Shapes.AddTextEffect( _
    PresetTextEffect:=msoTextEffect2, _
    Text:=sText, _
    FontName:="Times New Roman", _
    FontSize:=96, _
    FontBold:=msoTrue, _
    FontItalic:=msoFalse, _
    Left:=0, _
    Top:=0)
    .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    .RelativeVerticalPosition = wdRelativeVerticalPositionPage
    .Left = (sect.PageSetup.PageWidth - .Width) 2
    .Top = (sect.PageSetup.PageHeight - .Height) 2
    .Fill.ForeColor.RGB = RGB(240, 240, 240)
    End With
    End Sub

  10. #10
    Super Moderator
    Join Date
    Jan 2001
    Location
    Melbourne, Victoria, Australia
    Posts
    3,852
    Thanks
    4
    Thanked 259 Times in 239 Posts

    Re: Watermark questions (2000 SR-1)

    Hans

    I have found much to my dismay that the headers of the ENTIRE document share the same shapes collection.

    This means that after the first pass of the loop to remove the shapes from one section, I have found that no remaining shapes are present in the headers anywhere in the document.

    Is this different for you?
    Andrew Lockton, Chrysalis Design, Melbourne Australia

  11. #11
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Watermark questions (2000 SR-1)

    <img src=/S/blush.gif border=0 alt=blush width=15 height=15> You're right, Andrew. I just tested on a one-section, three-page document... So the loop to delete shapes should be right at the beginning. Thanks for pointing out my stupid error.

    The AddWatermarkTest macro becomes

    Sub AddWatermarkTest()
    Dim sect As Section
    Dim sText As String
    Dim hf As HeaderFooter
    Dim oShape As Shape

    sText = InputBox( _
    Prompt:="Enter a string for the watermark", _
    Title:="Watermark", _
    Default:="D R A F T")
    If sText = "" Then Exit Sub
    If ActiveDocument.Sections(1).Headers(wdHeaderFooterP rimary).Shapes.Count > 0 Then
    If MsgBox( _
    Prompt:="Do you wish me to replace the existing shapes with a watermark?", _
    Buttons:=vbQuestion + vbYesNo, _
    Title:="Watermark") = vbNo Then Exit Sub
    For Each oShape In ActiveDocument.Sections(1).Headers(wdHeaderFooterP rimary).Shapes
    oShape.Delete
    Next oShape
    End If
    For Each sect In ActiveDocument.Sections
    For Each hf In sect.Headers
    If Not hf.LinkToPrevious Then AddWatermarkToHeaderFooter sect, hf, sText
    Next hf
    Next sect
    End Sub

    AddWatermarkToHeaderFooter doesn't need to be changed for this.

  12. #12
    Plutonium Lounger
    Join Date
    Nov 2001
    Posts
    10,550
    Thanks
    0
    Thanked 7 Times in 7 Posts

    Re: Watermark questions (2000 SR-1)

    > AddWatermarkToHeaderFooter doesn't need to be changed for this.

    Are you sure. I still think that you need to specify an Anchor, otherwise the shape gets added to the general Header shapes collection at a "random" point.

    StuartR

  13. #13
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Watermark questions (2000 SR-1)

    Stuart, I inserted an (admittedly undesirable) hf.Range.Select in the main macro, so that the shape is anchored to (the first paragraph of) the header. I had tried specifying an anchor explicitly before that, but it didn't work for me - all shapes were dumped on top of each other, so I resorted to the Range.Select kludge... But if it works, specifying the anchor is more elegant, of course.

  14. #14
    New Lounger
    Join Date
    Oct 2002
    Location
    Florida, USA
    Posts
    13
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Watermark questions (2000 SR-1)

    Ok, I gathered up all the tips and information (kudos to all!) and assembled it into this macro:

    - - - - - - - - - -
    Sub AddWatermark()
    Dim sect As Section
    Dim oShape As Shape
    Dim sText As String
    Dim hf As HeaderFooter

    'Turns out that ALL the headers in the entire document share the
    'same Shapes collection, so they only need to be cleared once
    With ActiveDocument.Sections(1).Headers(wdHeaderFooterP rimary)
    If .Shapes.Count > 0 Then
    If MsgBox( _
    Prompt:="Do you wish me to replace the existing shapes with a watermark?", _
    Buttons:=vbQuestion + vbYesNo, _
    Title:="Watermark") = vbNo Then Exit Sub
    For Each oShape In .Shapes
    oShape.Delete
    Next oShape
    End If
    End With
    sText = InputBox( _
    Prompt:="Enter a string for the watermark", _
    Title:="Watermark", _
    Default:="D R A F T")
    If sText = "" Then Exit Sub
    For Each sect In ActiveDocument.Sections
    For Each hf In sect.Headers
    If Not hf.LinkToPrevious Then
    Set oShape = hf.Shapes.AddTextEffect( _
    PresetTextEffect:=msoTextEffect2, _
    Text:=sText, _
    FontName:="Times New Roman", _
    FontSize:=96, _
    FontBold:=msoTrue, _
    FontItalic:=msoFalse, _
    Left:=0, _
    Top:=0, _
    Anchor:=hf.Range.Paragraphs(1).Range)
    oShape.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    oShape.RelativeVerticalPosition = wdRelativeVerticalPositionPage
    oShape.Left = (sect.PageSetup.PageWidth - oShape.Width) 2
    oShape.Top = (sect.PageSetup.PageHeight - oShape.Height) 2
    oShape.Fill.ForeColor.RGB = RGB(240, 240, 240)
    End If
    Next hf
    Next sect
    End Sub
    - - - - - - - - - -
    And it works for the no checked box version and the odd/even only check box. But if the box for Different first page header and footers is checked in Page Setup,
    it is not working. I'm assuming that I am printing the graphic on top of itself somehow, so what else do I need to do here? Did I miss something?

    And as a side note - when pasting in code, unless i manually insert tab tags into the code it scrunchs it to the left margin -- is there a board option to convert 4 spaces to tab, or do I need to run my stuff through something to insert the tab tags? It would be easy enough to write, but I was wondering if something in the board does it automatically....

  15. #15
    Plutonium Lounger
    Join Date
    Nov 2001
    Posts
    10,550
    Thanks
    0
    Thanked 7 Times in 7 Posts

    Re: Watermark questions (2000 SR-1)

    Try using Hans' suggestion of hf.Range.Select instead of specifying the Anchor and see if that puts the graphics in the correct place.

    I put the <!t>[tab]<!/t> in my posts by pasting the code into Word and replacing 4 spaces with <!t>[tab]<!/t>, then selecting and copying again.

    StuartR

Page 1 of 2 12 LastLast

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •