Using L Kittles code for a printable watermark....

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target < Range("A1") Then Exit Sub
'On Error Resume Next
If Range("A1").Value = "x" Then

Dim Mud As Integer, Dum As Object
Mud = 190 '200
Application.ScreenUpdating = False
Dim Page As Integer
For Page = 1 To 1
ActiveSheet.Shapes.AddTextEffect(msoTextEffect1, _
"D R A F T", "Algerian", _
30#, msoFalse, msoFalse, 155, 105#).Select
With Selection
.Name = "Dum"
.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.IncrementTop Mud
End With

Next Page

Application.ScreenUpdating = True

ElseIf Range("A1").Value = "" Then
WaterMarkerGone
Exit Sub
End If

Range("A1").Select

End Sub

Sub WaterMarkerGone()
Application.ScreenUpdating = False
Dim Page As Integer
Dim Dum As Shape
For Page = 1 To 1
On Error Resume Next
ActiveSheet.Shapes("Dum").Select
Selection.Cut
Next Page
Application.ScreenUpdating = True
End Sub


When I enter X in A1 I dont get the watermark. I have enter the code in
This workbook module. I hae tried with the sheet protected and also without
protection. Any ideas?
Thanks in advance