Creating watermark macro for 400 staff

ryan1878 · #1 07-11-2016, 08:52 AM

Hi

I am currently setting up a tab in word 2013 that houses numerous macros to enable all staff to quickly enter what they need into legal documents.

I am however, having huge difficulty with inserting watermarks. As soon as I close the template down the macro breaks. This is an example of what I have so far. The watermark is an image, saved in a folder all staff have access to. The following macro should place PREP as a watermark.

Sub PREP()
'
' PREP Macro
'
'
ActiveDocument.Sections(1).Range.Select
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes("WordPictureWatermar k").Select
Selection.Delete
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
ActiveDocument.Sections(1).Range.Select
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes.AddPicture(FileName: = _

"E:\IT\MS Office 2013\PREP Watermark.png", LinkToFile:=False, _
SaveWithDocument:=True).Select
Selection.ShapeRange.Name = "WordPictureWatermark"
Selection.ShapeRange.PictureFormat.Brightness = 0.5
Selection.ShapeRange.PictureFormat.Contrast = 0.5
Selection.ShapeRange.LockAspectRatio = True
Selection.ShapeRange.Height = CentimetersToPoints(14.34)
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
End Sub
Any help on what I am doing wrong would be greatly appreciated. I have 5 of these to create

Thanks
Ryan

DougMVP · #2 07-13-2016, 02:45 AM

Try

Code:

Dim WM As Shape
With Selection.Sections(1).Headers(wdHeaderFooterPrimary)
    If .Shapes.count > 0 Then
        .Shapes(1).Delete
    End If
    Set WM = .Shapes.AddPicture(filename:="E:\IT\MS Office 2013\PREP Watermark.png")
    With WM
        With .PictureFormat
            .Brightness = 0.5
            .Contrast = 0.5
        End With
        .LockAspectRatio = True
        .Height = CentimetersToPoints(14.34)
        .Width = CentimetersToPoints(15.92)
        .WrapFormat.Type = 5
        .RelativeHorizontalPosition = wdRelativeVerticalPositionMargin
        .RelativeVerticalPosition = wdRelativeVerticalPositionMargin
        .Left = wdShapeCenter
        .Top = wdShapeCenter
    End With
End With

Thread Tools
Show Printable Version Email this Page
Display Modes
Switch to Linear Mode Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
help creating macro	tingker	Word VBA	4	01-08-2015 08:58 PM
Need Help Creating Macro	rsrasc	Word VBA	4	03-28-2014 01:31 PM
Project as a Staff-tracking Tool	Kerry	Project	1	03-01-2012 02:46 PM
creating macro	steveb	Word VBA	0	08-14-2010 01:29 AM
Using MSP to predict staff resource	jarvo273	Project	0	05-13-2010 04:05 AM