Watermark macro

[ER]

What's the easiest way I can get this code to insert the
watermark in the centre of the sheet (page) every time the
macro is run?

Thanks.
*****************************
Sub DraftWatermark()

Dim SH As Excel.Shape
Set SH = ActiveSheet.Shapes.AddTextEffect
(msoTextEffect1, _
"Draft", "Arial Black", 36#, _
msoFalse, msoFalse, 318.75, 159.75)
With SH
.IncrementRotation -43.46
.Fill.Visible = msoFalse
.Fill.Transparency = 0.5
.Line.Weight = 0.75
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
.Line.ForeColor.SchemeColor = 55
.Line.BackColor.RGB = RGB(255, 255, 255)
.ZOrder msoBringToFront
End With
End Sub

 

[Jim Vita]

Hi,

My name is Jim and I'll be working this newsgroup post with you. Give me a
little time to research and I'll post some sample code. Thanks for your
patience.


Thanks,

Jim

Jim Vita
Microsoft Developer Support

This posting is provided "AS IS" with no warranties, and confers no rights.

 

[Jim Vita]

Hi,

Don't know if you know this trick for figuring out how to do something in
automation. Record a macro while you're doing in the UI. Here is the
captured macro code that sets the Page Watermark. You must be in print view
to set the watermark. You should also check the watermark settings of your
printer to avoid other problems.


Sub Macro1()
'
' Macro1 Macro
' Macro recorded 3/4/2004 by Jim Vita
'
If ActiveWindow.View.SplitSpecial = wdPaneNone Then
ActiveWindow.ActivePane.View.Type = wdPrintView
Else
ActiveWindow.View.Type = wdPrintView
End If
ActiveDocument.Sections(1).Range.Select
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes.AddPicture(FileName:="C:\docs\test.GIF", _
LinkToFile:=False, SaveWithDocument:=True).Select
Selection.ShapeRange.Name = "WordPictureWatermark1"
Selection.ShapeRange.PictureFormat.Brightness = 0.85
Selection.ShapeRange.PictureFormat.Contrast = 0.15
Selection.ShapeRange.LockAspectRatio = True
Selection.ShapeRange.Height = InchesToPoints(4.8)
Selection.ShapeRange.Width = InchesToPoints(6)
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


Thanks,

Jim

Jim Vita
Microsoft Developer Support

This posting is provided "AS IS" with no warranties, and confers no rights.