none
Macro button that can print out my document with watermark "COPY" RRS feed

  • Question

  • I need to make button that starts printing, an put on a watermark on all pages, including my special front page.

     I tried to record it but i fails and dont show on first(special) page.

    Can anyone help me with that?

    Wednesday, April 24, 2013 11:40 AM

Answers

  • For what you are trying to achieve, you would need code like:

    Sub PrintWatermarked()
    Application.ScreenUpdating = False
    Dim Sctn As Section, HdFt As HeaderFooter, Shp As Shape, i As Long
    With ActiveDocument
      For Each Sctn In .Sections
        For Each HdFt In Sctn.Headers
          If HdFt.LinkToPrevious = False Then
            i = i + 1
            Set Shp = HdFt.Shapes.AddTextEffect(0, "KOPI", "Arial", 54, False, False, 0, 0)
            With Shp
              .Name = "WaterMark" & i
              .TextEffect.NormalizedHeight = False
              .Line.Visible = False
              .Fill.Visible = True
              .Fill.Solid
              .Fill.ForeColor.RGB = RGB(255, 0, 0)
              .Fill.Transparency = 0.5
              .Rotation = 315
              .LockAspectRatio = True
              .Height = CentimetersToPoints(2.14)
              .Width = CentimetersToPoints(4.55)
              .WrapFormat.AllowOverlap = True
              .WrapFormat.Side = wdWrapNone
              .WrapFormat.Type = 3
              .RelativeHorizontalPosition = wdRelativeVerticalPositionMargin
              .RelativeVerticalPosition = wdRelativeVerticalPositionMargin
              .Left = wdShapeCenter
              .Top = wdShapeCenter
            End With
          End If
        Next
      Next
      .PrintOut
      For Each Sctn In .Sections
        For Each HdFt In Sctn.Headers
          If HdFt.LinkToPrevious = False Then
            For Each Shp In HdFt.Shapes
              If Shp.Name Like "WaterMark#*" Then Shp.Delete
            Next
          End If
        Next
      Next
    End With
    Application.ScreenUpdating = True
    End Sub

    Note that you can't programmatically add a watermark with a name like PowerPlusWaterMarkObject11005168 - you need to specify it as a valid MsoPresetTextEffect. Since I don't know which one the PowerPlusWaterMarkObject name relates to, I've left it at 0 (there are 30 possibilities). You can change the '0' in 'AddTextEffect(0' to whichever one suits your requirements.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    • Marked as answer by Julian Olsen Thursday, April 25, 2013 9:39 AM
    Thursday, April 25, 2013 4:10 AM

All replies

  • For cross-posting etiquette, please read: http://www.excelguru.ca/content.php?184

    What macro code are you using and what is your document's page setup & section configuration?

    Cheers
    Paul Edstein
    [MS MVP - Word]

    Wednesday, April 24, 2013 12:08 PM
  • Im sorry :-/

    When i record the macro there is no problem, but if i play the macro after, the watermark doesnt show on the first page.

    i think its something with "Different first page" ?

    This is my macro code.

        ActiveDocument.Sections(1).Range.Select
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
        Selection.HeaderFooter.Shapes.AddTextEffect( _
            PowerPlusWaterMarkObject11005168, "KOPI", "Arial", 54, False, False, 0, 0 _
            ).Select
        Selection.ShapeRange.Name = "PowerPlusWaterMarkObject11005168"
        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(255, 0, 0)
        Selection.ShapeRange.Fill.Transparency = 0.5
        Selection.ShapeRange.Rotation = 315
        Selection.ShapeRange.LockAspectRatio = True
        Selection.ShapeRange.Height = CentimetersToPoints(2.14)
        Selection.ShapeRange.Width = CentimetersToPoints(4.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
        ActiveWindow.ActivePane.VerticalPercentScrolled = 9
        Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _
            wdPrintDocumentWithMarkup, Copies:=1, Pages:="", PageType:= _
            wdPrintAllPages, Collate:=True, Background:=True, PrintToFile:=False, _
            PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
            PrintZoomPaperHeight:=0
        ActiveDocument.Sections(1).Range.Select
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
        Selection.HeaderFooter.Shapes("PowerPlusWaterMarkObject11005168").Select
        Selection.Delete
        ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
        ActiveDocument.Shapes.Range(Array("Tekstfelt 2")).Select
    End Sub
    Thanks
    Wednesday, April 24, 2013 12:37 PM
  • For what you are trying to achieve, you would need code like:

    Sub PrintWatermarked()
    Application.ScreenUpdating = False
    Dim Sctn As Section, HdFt As HeaderFooter, Shp As Shape, i As Long
    With ActiveDocument
      For Each Sctn In .Sections
        For Each HdFt In Sctn.Headers
          If HdFt.LinkToPrevious = False Then
            i = i + 1
            Set Shp = HdFt.Shapes.AddTextEffect(0, "KOPI", "Arial", 54, False, False, 0, 0)
            With Shp
              .Name = "WaterMark" & i
              .TextEffect.NormalizedHeight = False
              .Line.Visible = False
              .Fill.Visible = True
              .Fill.Solid
              .Fill.ForeColor.RGB = RGB(255, 0, 0)
              .Fill.Transparency = 0.5
              .Rotation = 315
              .LockAspectRatio = True
              .Height = CentimetersToPoints(2.14)
              .Width = CentimetersToPoints(4.55)
              .WrapFormat.AllowOverlap = True
              .WrapFormat.Side = wdWrapNone
              .WrapFormat.Type = 3
              .RelativeHorizontalPosition = wdRelativeVerticalPositionMargin
              .RelativeVerticalPosition = wdRelativeVerticalPositionMargin
              .Left = wdShapeCenter
              .Top = wdShapeCenter
            End With
          End If
        Next
      Next
      .PrintOut
      For Each Sctn In .Sections
        For Each HdFt In Sctn.Headers
          If HdFt.LinkToPrevious = False Then
            For Each Shp In HdFt.Shapes
              If Shp.Name Like "WaterMark#*" Then Shp.Delete
            Next
          End If
        Next
      Next
    End With
    Application.ScreenUpdating = True
    End Sub

    Note that you can't programmatically add a watermark with a name like PowerPlusWaterMarkObject11005168 - you need to specify it as a valid MsoPresetTextEffect. Since I don't know which one the PowerPlusWaterMarkObject name relates to, I've left it at 0 (there are 30 possibilities). You can change the '0' in 'AddTextEffect(0' to whichever one suits your requirements.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    • Marked as answer by Julian Olsen Thursday, April 25, 2013 9:39 AM
    Thursday, April 25, 2013 4:10 AM
  • You are a genius :)

    Thank you very much

    Thursday, April 25, 2013 9:39 AM