Hi rsl,
Run this in the sheet module and see what has to be tweeked to suit your
needs. Can change the number of sheets as needed as well as the watermark
wording and font size. Change the "For Page = 1 To 1
" to do multiple sheets. ie- = 1 to 5.
Sub WaterMarkerHP() 'Horizontal Portrait
On Error Resume Next
WaterMarkerGone
Dim Mud As Integer, Dum As Object
Mud = -185
Application.ScreenUpdating = False
ActiveSheet.PageSetup.PrintArea = "$A$1:$P$41"
With ActiveSheet.PageSetup
.Orientation = xlPortrait
End With
Dim Page As Integer
For Page = 1 To 1
ActiveSheet.Shapes.AddTextEffect(msoTextEffect1, _
"Budgetary Access Pricing", "Arial", _
24, msoFalse, msoFalse, 269, 105#).Select
Selection.Name = "Dum"
With Selection
.ShapeRange.Fill.Visible = msoTrue
.ShapeRange.Fill.Solid
.ShapeRange.Fill.ForeColor.SchemeColor = 22
.ShapeRange.Fill.Transparency = 0.5
.ShapeRange.Line.Visible = msoFalse
.ShapeRange.IncrementRotation -26.22
.ShapeRange.IncrementLeft Mud
.ShapeRange.IncrementTop 100
End With
Mud = Mud + 624.5
Next Page
Range("A1").Value = ""
Range("A1").Select
Application.ScreenUpdating = True
End Sub
Sub WaterMarkerGone()
Application.ScreenUpdating = False
On Error Resume Next
Dim Page As Integer
For Page = 1 To 1
ActiveSheet.Shapes("Dum").Select
Selection.Cut
Next Page
Application.CutCopyMode = False
Range("A1").Value = ""
Range("A1").Select
Application.ScreenUpdating = True
End Sub
You can also use word art (which the above code is a modified recorded macro
of) to do the same thing on a single sheet, set the transparancy, remove
borders, size the font and tilt to your desire.
HTH
Regards,
Howard
