none
Using Watermarks in macros Word 2010 RRS feed

  • Question

  • I am trying to record a macro in word 2010 to allow a user to print three copies of a single page document, 1st print has no watermark and then print 2 has "file copy" and print 3 "remittance advice" watermakrs. The macro records fine and will run ok until exiting out of word and then going back in. When I then try the macro I get the error "run time error 5 invalid call procedure or argument". When you select debug the line "Selection.ShapeRange.Name = "PowerPlusWaterMarkObject260688606" is highlighted. I have tried everything I can think of to sort this including using building blocks but I just get different errors with this. Any help would be appreciated. I never had any problems with Word 2003!

     

    Sub aaa()
    '
    ' aaa Macro
    '
    '
        ActiveDocument.Sections(1).Range.Select
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
        Selection.HeaderFooter.Shapes.AddTextEffect( _
            PowerPlusWaterMarkObject260688606, "File copy", "Tahoma", 1, False, False _
            , 0, 0).Select
        Selection.ShapeRange.Name = "PowerPlusWaterMarkObject260688606"
        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(128, 128, 128)
        Selection.ShapeRange.Fill.Transparency = 0.5
        Selection.ShapeRange.Rotation = 0
        Selection.ShapeRange.LockAspectRatio = True
        Selection.ShapeRange.Height = CentimetersToPoints(4.55)
        Selection.ShapeRange.Width = CentimetersToPoints(15.92)
        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
        ActiveDocument.Sections(1).Range.Select
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
        Selection.HeaderFooter.Shapes("PowerPlusWaterMarkObject260688606").Select
        Selection.Delete
        ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
        ActiveDocument.Sections(1).Range.Select
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
        Selection.HeaderFooter.Shapes.AddTextEffect( _
            PowerPlusWaterMarkObject260719806, "Remittance Advice", "Tahoma", 1, _
            False, False, 0, 0).Select
        Selection.ShapeRange.Name = "PowerPlusWaterMarkObject260719806"
        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(128, 128, 128)
        Selection.ShapeRange.Fill.Transparency = 0.5
        Selection.ShapeRange.Rotation = 0
        Selection.ShapeRange.LockAspectRatio = True
        Selection.ShapeRange.Height = CentimetersToPoints(1.99)
        Selection.ShapeRange.Width = CentimetersToPoints(15.92)
        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
        ActiveDocument.Sections(1).Range.Select
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
        Selection.HeaderFooter.Shapes("PowerPlusWaterMarkObject260719806").Select
        Selection.Delete
        ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    End Sub

    Friday, November 25, 2011 4:00 PM

Answers

  • Hi Sarah

    Using the following is always a bit of a lottery:

        ActiveDocument.Sections(1).Range.Select
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader

    It's better to work more closely with the object model, rather than rely on "Selection". The macro recorder can only give you "Selection" because it emulates what you do as a user. So sometimes it's necessary to "tweak" the macro result to make it more robust.

    In this case, I'd try something more like:

        Dim hf as Word.HeaderFooter
        Set hf = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary)
        Dim shp as Word.Shape
        Set shp = hf.Shapes.AddTextEffect( _
            PowerPlusWaterMarkObject260688606, "File copy", "Tahoma", 1, False, False _
            , 0, 0, hf.Range)
        shp.Name = "PowerPlusWaterMarkObject260688606"

    A couple of remarks about this:

    1. In the method AddTextEffect the first parameter - PowerPlusWaterMarkObject260688606 - cannot be correct and certainly is not what the macro recorder recorded.

    2. You'll noticed I added a parameter at the end of that method: hf.Range. I'm telling Word to anchor the Shape to the Header range for this section, specifically.

    3. Notice how I declare a Shape object (shp) then assign the WordArt to that. Afterwards, use shp instead of Selection.ShapeRange or anything else in order to work with the WordArt. Then it won't matter at all where the selection is ,the macro will work with the correct object.

    4. You'll also notice that, if you remove the code that activates the header/footer or the main document that the Selection won't change at all and there will be less screen "flicker".

    5. I get an error when I try to assign the name "PowerPlusWaterMarkObject260688606" to a Shape object. It's too long: 33 characters. A Shape.Name can be a maximum of 32 characters (at least in the version of Office I'm using).


    Cindy Meister, VSTO/Word MVP
    Sunday, November 27, 2011 7:43 AM
    Moderator
  • I think the problem is that you are trying to set and get a specifically named watermark but that Word actually assigns a unique number coding to each watermark when they are added ... at least that's what I believe to be true.

    Here are two routines that that do work for setting and getting unique watermarks. Hopefully you can adjust them to your unique needs.

    Sub SetWatermarks()
        Dim scn As Word.Section, hdft As Word.HeaderFooter, shp As Word.Shape
        With Word.ActiveDocument
          For Each scn In .Sections
            For Each hdft In scn.Headers
              Set shp = hdft.Shapes.AddTextEffect(msoTextEffect2, "Evaluation Only", "Tahoma", 10, False, False, 0, 0)
              With shp
                .line.Visible = False
                With .TextEffect
                  .NormalizedHeight = False
                  .FontItalic = False
                  .FontBold = True
                End With
                With .Fill
                  .Visible = True
                  .Solid
                  .ForeColor.RGB = 12632256
                  .Transparency = 0.5
                End With
                .Rotation = 315
                .LockAspectRatio = True
                .Height = Word.InchesToPoints(1.96)
                .Width = Word.InchesToPoints(7.2)
                With .WrapFormat
                  .AllowOverlap = True
                  .Side = Word.wdWrapNone
                  .Type = 3
                End With
                .RelativeHorizontalPosition = Word.wdRelativeHorizontalPositionMargin
                .RelativeVerticalPosition = Word.wdRelativeVerticalPositionMargin
                .Left = wdShapeCenter
                .top = wdShapeCenter
              End With
            Next hdft
          Next scn
        End With
    End Sub
    
    Sub FindWaterMark()
            
        Dim doc As Word.Document
        Dim scn As Word.Section
        Dim shp As Word.Shape
        Dim hdft As Word.HeaderFooter
        
        Set doc = Word.ActiveDocument
        
        With doc
          For Each scn In .Sections
            For Each hdft In scn.Headers
                For Each shp In hdft.Range.ShapeRange
                    If InStr(1, shp.Name, "WordArt") <> 0 Or InStr(1, shp.Name, "Power") <> 0 Then
                        If shp.TextEffect.Text = "Evaluation Only" Then
                            Debug.Print shp.Name
                        End If
                    End If
                Next shp
            Next hdft
          Next scn
        End With
    
    End Sub
    
    

     


    Kind Regards, Rich ... http://greatcirclelearning.com
    Friday, November 25, 2011 10:27 PM

All replies

  • I think the problem is that you are trying to set and get a specifically named watermark but that Word actually assigns a unique number coding to each watermark when they are added ... at least that's what I believe to be true.

    Here are two routines that that do work for setting and getting unique watermarks. Hopefully you can adjust them to your unique needs.

    Sub SetWatermarks()
        Dim scn As Word.Section, hdft As Word.HeaderFooter, shp As Word.Shape
        With Word.ActiveDocument
          For Each scn In .Sections
            For Each hdft In scn.Headers
              Set shp = hdft.Shapes.AddTextEffect(msoTextEffect2, "Evaluation Only", "Tahoma", 10, False, False, 0, 0)
              With shp
                .line.Visible = False
                With .TextEffect
                  .NormalizedHeight = False
                  .FontItalic = False
                  .FontBold = True
                End With
                With .Fill
                  .Visible = True
                  .Solid
                  .ForeColor.RGB = 12632256
                  .Transparency = 0.5
                End With
                .Rotation = 315
                .LockAspectRatio = True
                .Height = Word.InchesToPoints(1.96)
                .Width = Word.InchesToPoints(7.2)
                With .WrapFormat
                  .AllowOverlap = True
                  .Side = Word.wdWrapNone
                  .Type = 3
                End With
                .RelativeHorizontalPosition = Word.wdRelativeHorizontalPositionMargin
                .RelativeVerticalPosition = Word.wdRelativeVerticalPositionMargin
                .Left = wdShapeCenter
                .top = wdShapeCenter
              End With
            Next hdft
          Next scn
        End With
    End Sub
    
    Sub FindWaterMark()
            
        Dim doc As Word.Document
        Dim scn As Word.Section
        Dim shp As Word.Shape
        Dim hdft As Word.HeaderFooter
        
        Set doc = Word.ActiveDocument
        
        With doc
          For Each scn In .Sections
            For Each hdft In scn.Headers
                For Each shp In hdft.Range.ShapeRange
                    If InStr(1, shp.Name, "WordArt") <> 0 Or InStr(1, shp.Name, "Power") <> 0 Then
                        If shp.TextEffect.Text = "Evaluation Only" Then
                            Debug.Print shp.Name
                        End If
                    End If
                Next shp
            Next hdft
          Next scn
        End With
    
    End Sub
    
    

     


    Kind Regards, Rich ... http://greatcirclelearning.com
    Friday, November 25, 2011 10:27 PM
  • Hi Sarah

    Using the following is always a bit of a lottery:

        ActiveDocument.Sections(1).Range.Select
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader

    It's better to work more closely with the object model, rather than rely on "Selection". The macro recorder can only give you "Selection" because it emulates what you do as a user. So sometimes it's necessary to "tweak" the macro result to make it more robust.

    In this case, I'd try something more like:

        Dim hf as Word.HeaderFooter
        Set hf = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary)
        Dim shp as Word.Shape
        Set shp = hf.Shapes.AddTextEffect( _
            PowerPlusWaterMarkObject260688606, "File copy", "Tahoma", 1, False, False _
            , 0, 0, hf.Range)
        shp.Name = "PowerPlusWaterMarkObject260688606"

    A couple of remarks about this:

    1. In the method AddTextEffect the first parameter - PowerPlusWaterMarkObject260688606 - cannot be correct and certainly is not what the macro recorder recorded.

    2. You'll noticed I added a parameter at the end of that method: hf.Range. I'm telling Word to anchor the Shape to the Header range for this section, specifically.

    3. Notice how I declare a Shape object (shp) then assign the WordArt to that. Afterwards, use shp instead of Selection.ShapeRange or anything else in order to work with the WordArt. Then it won't matter at all where the selection is ,the macro will work with the correct object.

    4. You'll also notice that, if you remove the code that activates the header/footer or the main document that the Selection won't change at all and there will be less screen "flicker".

    5. I get an error when I try to assign the name "PowerPlusWaterMarkObject260688606" to a Shape object. It's too long: 33 characters. A Shape.Name can be a maximum of 32 characters (at least in the version of Office I'm using).


    Cindy Meister, VSTO/Word MVP
    Sunday, November 27, 2011 7:43 AM
    Moderator