Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Watermark
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Watermark
This works for me, however, VB is case sensitive, so if I put a capital
X in A1 it won't work. However, it will work with a small x. Any other info you have? I would suggest adding Application.CutCopyMode = False, the end of your WaterMarkerGone. Makes it a bit more seamless. Darrin *** Sent via Developersdex http://www.developersdex.com *** |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Watermark
Works for me with no changes.
You're using a lower-case "x", right? -- Tim Williams Palo Alto, CA "Steve" wrote in message ... 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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Watermark
Disregard item 1--my eyes are a bit blurred, it is late in the day. I
must have blended a couple of lines together when I was reading it. I would look to see if it inadvertently brought in the dashes when you pasted the code in--as described in item 2. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Watermark | Excel Worksheet Functions | |||
watermark | Excel Discussion (Misc queries) | |||
WaterMark | Excel Discussion (Misc queries) | |||
How do I add a watermark? | Excel Discussion (Misc queries) | |||
Watermark | Excel Programming |