Question : Watermark macro

I need some help with a watermark macro. Couldn't find anything on EE, even though this must have been asked hundreds of times.

What I need is a macro that will insert the words "draft" on my document when I run it. If the document already has a watermark, it has to be removed, and instead inser the "draft" watermark. Then if I run the macro again it will remove the watermark. That way I can create a botton to use it. And I can easly change the watermark to eg. "copy" with a similar macro.

Hope this can be done.

Answer : Watermark macro

Oops. Forgot to post the code

Sub InsertWaterMarks()
    Dim sec As Section
    Dim hdr As HeaderFooter
    Dim sh As Shape
    Dim i As Integer
    Dim shHeaders As Shapes
    Dim strText As String
    Dim Doc As Document
    Set Doc = ActiveDocument
    strText = "COPY"
    Set shHeaders = Doc.Sections(1).Headers(1).Shapes
   
    'Delete any existing watermarks
    For Each sh In shHeaders
        If InStr(sh.Name, "PowerPlusWaterMarkObject") = 1 Then
            sh.Delete
        End If
    Next sh
   
    'Add shape to headers shapes collection after selecting each header
    Doc.Range.Select
    For Each sec In Doc.Sections
        For Each hdr In sec.Headers
            If sec.Index = 1 Or hdr.LinkToPrevious = False Then
                i = i + 1
                hdr.Range.Select
                Set sh = shHeaders.AddTextEffect(msoTextEffect1, _
                    strText, "Arial", 1, False, False, 0, 0)
                sh.Name = "PowerPlusWaterMarkObject" & i
                sh.TextEffect.NormalizedHeight = False
                sh.Line.Visible = msoTrue
                sh.Line.Weight = 0.25
                sh.Line.DashStyle = msoLineSolid
                sh.Line.Style = msoLineSingle
                sh.Fill.Visible = msoFalse
                sh.Fill.Solid
                sh.Line.ForeColor.RGB = RGB(0, 0, 0)
                sh.Line.BackColor.RGB = RGB(255, 255, 255)
                sh.Fill.Transparency = 0#
                sh.Rotation = 315
                sh.LockAspectRatio = True
                sh.Height = CentimetersToPoints(6.88)
                sh.Width = CentimetersToPoints(13.77)
                sh.WrapFormat.AllowOverlap = True
                sh.WrapFormat.Side = wdWrapNone
                sh.WrapFormat.Type = 3
                sh.RelativeHorizontalPosition = _
                    wdRelativeVerticalPositionMargin
                sh.RelativeVerticalPosition = _
                    wdRelativeVerticalPositionMargin
                sh.Left = wdShapeCenter
                sh.Top = wdShapeCenter
            End If
        Next hdr
    Next sec
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
If ActiveWindow.View.SplitSpecial = wdPaneNone Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    Else
        ActiveWindow.View.Type = wdPrintView
    End If
End Sub

Random Solutions  
 
programming4us programming4us