Watermark
Hi, I found a couple of things with the code you supplied and made
changes.
1) you were compairing the target object to the value of cell A1.
2) when I copied this into my editor from his example and yours it
brought in some dashes in the reserved words within word art portion of
the code. i.e. .ShapeRange.Fill.ForeColor.Sch*-emeColor = 22. this may
have affected your code in your editor as well.
I may have also changed a few other minor things, but this is what
worked for me:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Debug.Print ""
Debug.Print Target.Address(False, False)
Debug.Print Sh.Name
If Target.Address(False, False) < "A1" Then Exit Sub
If Sh.Name < "Sheet1" 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
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
Application.ScreenUpdating = True
ElseIf Range("A1").Value = "" Then
WaterMarkerGone
Application.CutCopyMode = False
Exit Sub
End If
Range("A1").Select
End Sub
Public 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").Sele*ct
Selection.Cut
Next Page
Application.ScreenUpdating = True
End Sub
HTH--Lonnie M.
|