Watermark macro

[niros49]

I have recorded a macro to insert a picture watermark and then move the
watermark to a new position on the page different then the default . The
macro is crashing on line :

Selection.ShapeRange.Name = "WordPictureWatermark1"


Below is the recorded macro.

Can anybody help?

Thank you


Sorin

Sub Macropicture()
'
' Macropicture Macro
' Macro recorded 4/22/2010 by weisssx5
'
ActiveDocument.Sections(1).Range.Select
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes.AddPicture(FileName:= _
"C:\Documents and Settings\weisssx5\Desktop\Stamp Paint.bmp",
LinkToFile _
:=False, SaveWithDocument:=True).Select
Selection.ShapeRange.Name = "WordPictureWatermark1"
Selection.ShapeRange.PictureFormat.Brightness = 0.5
Selection.ShapeRange.PictureFormat.Contrast = 0.5
Selection.ShapeRange.LockAspectRatio = True
Selection.ShapeRange.Height = InchesToPoints(1.32)
Selection.ShapeRange.Width = InchesToPoints(3.18)
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
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes("WordPictureWatermark1").Select
Selection.ShapeRange.IncrementLeft -164.65
Selection.ShapeRange.IncrementTop 65.6
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub

 

[Graham Mayor]

The macro recorder has limitations and adds superfluous code. Using your
approach, the following should work

Sub Macropicture()
ActiveDocument.Sections(1).Range.Select
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes.AddPicture(FileName:= _
"C:\Documents and Settings\weisssx5\Desktop\Stamp Paint.bmp",
LinkToFile _
:=False, SaveWithDocument:=True).Select
Selection.ShapeRange.name = "MyWMark"
Selection.ShapeRange.PictureFormat.Brightness = 0.5
Selection.ShapeRange.PictureFormat.Contrast = 0.5
Selection.ShapeRange.LockAspectRatio = True
Selection.ShapeRange.Height = InchesToPoints(1.32)
Selection.ShapeRange.Width = InchesToPoints(3.18)
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
Selection.ShapeRange.IncrementLeft -164.65
Selection.ShapeRange.IncrementTop 65.6
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub

It might be better to use

Dim oHeader As HeaderFooter
Set oHeader = ActiveDocument.Sections(1) _
..Headers(wdHeaderFooterPrimary)
With oHeader
.Shapes.AddPicture FileName:= _
"C:\Documents and Settings\weisssx5\Desktop\Stamp Paint.bmp", _
LinkToFile:=False, SaveWithDocument:=True
With .Shapes(1)
.name = "MyWMark"
.PictureFormat.Brightness = 0.5
.PictureFormat.Contrast = 0.5
.LockAspectRatio = True
.Height = InchesToPoints(1.32)
.Width = InchesToPoints(3.18)
.WrapFormat.AllowOverlap = True
.WrapFormat.Side = wdWrapNone
.WrapFormat.Type = 3
.RelativeHorizontalPosition = _
wdRelativeVerticalPositionMargin
.RelativeVerticalPosition = _
wdRelativeVerticalPositionMargin
.Left = wdShapeCenter
.Top = wdShapeCenter
.IncrementLeft -164.65
.IncrementTop 65.6
End With
End With


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[niros49]

I thank you very much for your help.

Sorin

The macro recorder has limitations and adds superfluous code. Using your
approach, the following should work

Sub Macropicture()
ActiveDocument.Sections(1).Range.Select
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes.AddPicture(FileName:= _
"C:\Documents and Settings\weisssx5\Desktop\Stamp Paint.bmp",
LinkToFile _
:=False, SaveWithDocument:=True).Select
Selection.ShapeRange.name = "MyWMark"
Selection.ShapeRange.PictureFormat.Brightness = 0.5
Selection.ShapeRange.PictureFormat.Contrast = 0.5
Selection.ShapeRange.LockAspectRatio = True
Selection.ShapeRange.Height = InchesToPoints(1.32)
Selection.ShapeRange.Width = InchesToPoints(3.18)
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
Selection.ShapeRange.IncrementLeft -164.65
Selection.ShapeRange.IncrementTop 65.6
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub

It might be better to use

Dim oHeader As HeaderFooter
Set oHeader = ActiveDocument.Sections(1) _
..Headers(wdHeaderFooterPrimary)
With oHeader
.Shapes.AddPicture FileName:= _
"C:\Documents and Settings\weisssx5\Desktop\Stamp Paint.bmp", _
LinkToFile:=False, SaveWithDocument:=True
With .Shapes(1)
.name = "MyWMark"
.PictureFormat.Brightness = 0.5
.PictureFormat.Contrast = 0.5
.LockAspectRatio = True
.Height = InchesToPoints(1.32)
.Width = InchesToPoints(3.18)
.WrapFormat.AllowOverlap = True
.WrapFormat.Side = wdWrapNone
.WrapFormat.Type = 3
.RelativeHorizontalPosition = _
wdRelativeVerticalPositionMargin
.RelativeVerticalPosition = _
wdRelativeVerticalPositionMargin
.Left = wdShapeCenter
.Top = wdShapeCenter
.IncrementLeft -164.65
.IncrementTop 65.6
End With
End With


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>





.

 

[Graham Mayor]

You are welcome

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>