View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Chip Pearson Chip Pearson is offline
external usenet poster
 
Posts: 7,247
Default Macro trouble: inserting 'watermark'

Try the following:


Dim SH As Excel.Shape
Set SH = ActiveSheet.Shapes.AddTextEffect(msoTextEffect1, _
"Draft", "Arial Black", 36#, _
msoFalse, msoFalse, 318.75, 159.75)
With SH
.IncrementRotation -43.46
.Fill.Visible = msoFalse
.Fill.Transparency = 0.5
.Line.Weight = 0.75
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
.Line.ForeColor.SchemeColor = 55
.Line.BackColor.RGB = RGB(255, 255, 255)
.ZOrder msoBringToFront
End With


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com

"ER" wrote in message
...
I have recorded amacro that inserts a 'watermark' text in
a workbook. However, when I try to run it, it breaks on
the line when the specific Word art shape is being
selected. I doesn't matter which shape I choose, it always
breaks on this line. When I set a watch on this
expression, it shows 'The item with the specified name
wasn't found'. The code is below. can anybody help with
this? Also, where would I save this macro so it's available
on any worksheet I work on in Excel?

Thanks


Sub Watermark()

ActiveSheet.Shapes.AddTextEffect
(msoTextEffect1, "Draft", "Arial Black", 36# _
, msoFalse, msoFalse, 318.75, 159.75).Select
Range("I11:I13").Select
Range("I13").Activate
ActiveSheet.Shapes("WordArt 13").Select
Selection.ShapeRange.IncrementRotation -43.46
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Transparency = 0.5
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 55
Selection.ShapeRange.Line.BackColor.RGB = RGB(255,
255, 255)
Selection.ShapeRange.ZOrder msoBringToFront
End Sub