Jesse.Burns
11-09-2009, 07:22 AM
Hello,
I've recently been trying to write a macro that will, once triggered by a specific result, populate the word "Incomplete" across a specific sheet in the workbook. Using some code that I found online, along with some formatting code that I got using the macro recorder, I have been able to succesfully populate the WordArt and lock the sheet so that no one can delete the mark. However, I would like to be able to give the word no fill color so that someone will be able to click inside of and edit the cells that are being covered by the mark. Whenever I use the macro recorder and manually give the shape no fill color, the resulting code still gives me a default white background.
Here is the code that I am referring to:
Sub Watermark()
Dim mydocument As Worksheet
Dim newWordArt As Object
With Worksheets(1).Select
ActiveSheet.Unprotect Password:="password"
Set mydocument = Worksheets(1)
Set newWordArt = mydocument.Shapes.AddTextEffect(PresetTextEffect:=msoTextEffect7, Text:="Incomplete", _
FontName:="Arial Black", FontSize:=100, _
FontBold:=msoTrue, FontItalic:=msoFalse, Left:=10, _
Top:=10)
newWordArt.Select
Selection.ShapeRange.IncrementLeft 129#
Selection.ShapeRange.IncrementTop 179.25
Selection.ShapeRange.IncrementRotation -24.39
Selection.ShapeRange.IncrementLeft -48.75
Selection.ShapeRange.IncrementTop -68.25
Selection.ShapeRange.ScaleWidth 1.12, msoFalse, msoScaleFromBottomRight
Selection.ShapeRange.IncrementLeft 34.5
Selection.ShapeRange.IncrementTop 0.75
Selection.ShapeRange.ScaleHeight 1.36, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 1.04, msoFalse, msoScaleFromBottomRight
Selection.ShapeRange.ScaleHeight 1.07, msoFalse, msoScaleFromBottomRight
Selection.ShapeRange.ScaleWidth 1.01, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.IncrementLeft -24#
Selection.ShapeRange.IncrementTop 1.5
Selection.ShapeRange.Line.Weight = 3#
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 = 48
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Line.Weight = 3#
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 = 48
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.Transparency = 0#
Range("B8").Select
ActiveSheet.Protect Password:="password"
End Sub
Any ideas on how I can make this work? Please let me know if you have any specific questions.
Thank you
-Jesse
I've recently been trying to write a macro that will, once triggered by a specific result, populate the word "Incomplete" across a specific sheet in the workbook. Using some code that I found online, along with some formatting code that I got using the macro recorder, I have been able to succesfully populate the WordArt and lock the sheet so that no one can delete the mark. However, I would like to be able to give the word no fill color so that someone will be able to click inside of and edit the cells that are being covered by the mark. Whenever I use the macro recorder and manually give the shape no fill color, the resulting code still gives me a default white background.
Here is the code that I am referring to:
Sub Watermark()
Dim mydocument As Worksheet
Dim newWordArt As Object
With Worksheets(1).Select
ActiveSheet.Unprotect Password:="password"
Set mydocument = Worksheets(1)
Set newWordArt = mydocument.Shapes.AddTextEffect(PresetTextEffect:=msoTextEffect7, Text:="Incomplete", _
FontName:="Arial Black", FontSize:=100, _
FontBold:=msoTrue, FontItalic:=msoFalse, Left:=10, _
Top:=10)
newWordArt.Select
Selection.ShapeRange.IncrementLeft 129#
Selection.ShapeRange.IncrementTop 179.25
Selection.ShapeRange.IncrementRotation -24.39
Selection.ShapeRange.IncrementLeft -48.75
Selection.ShapeRange.IncrementTop -68.25
Selection.ShapeRange.ScaleWidth 1.12, msoFalse, msoScaleFromBottomRight
Selection.ShapeRange.IncrementLeft 34.5
Selection.ShapeRange.IncrementTop 0.75
Selection.ShapeRange.ScaleHeight 1.36, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 1.04, msoFalse, msoScaleFromBottomRight
Selection.ShapeRange.ScaleHeight 1.07, msoFalse, msoScaleFromBottomRight
Selection.ShapeRange.ScaleWidth 1.01, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.IncrementLeft -24#
Selection.ShapeRange.IncrementTop 1.5
Selection.ShapeRange.Line.Weight = 3#
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 = 48
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Line.Weight = 3#
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 = 48
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.Transparency = 0#
Range("B8").Select
ActiveSheet.Protect Password:="password"
End Sub
Any ideas on how I can make this work? Please let me know if you have any specific questions.
Thank you
-Jesse