how do i watermark an excel spreadsheet?

  • Thread starter Thread starter rsl
  • Start date Start date
R

rsl

office 2000, would like to have watermark behind text in spreadsheet, to
appear centre page, almost full size of page.
 
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
 
Back
Top