Using VBA to create WordArt

[Jesse.Burns]

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

[RolfJ]

Increase the transparency by using a statement like this one:


Selection.ShapeRange.Fill.Transparency = 0.92

[Jesse.Burns]

Thank you for the quick response. I should probably explain the situation a little more in depth.

As you can probably tell from the code that I posted above, I used the macro recorder to format the WordArt and reposition it on the sheet. Initially I attempted to increase the transparency so that the cells underneath would be visible. Even at 100% transparency, the results were only so-so.

Unfortunately, the workbook that I am trying to apply this code to is a request template. Currently, someone fills out all of the relevant request information, and then I will use this information to perform analysis. Currently, we have a macro that keeps anyone from saving the template if any of the minimum fields have been left blank.

This has caused somewhat of a backlash, as the people using this form would like the ability to save the template in an incomplete state, and return to the file later to complete and then submit. My goal here is to populate the word "Incomplete" across the body of the sheet so that the person filling it out will know that we will not accept their request as is.

If I simply increase the transparency, the template will no longer be as functional, as the person filling it out will not be able to click into the cells that the text covers.

When formatted manually, I am able to select "No fill" for the body of the word, and therefore a simple outline remains. This does allow someone to click within all the cells when the "Incomplete" stamp is present. However, when I do this while recording a macro, the code that is generated gives me a solid white background for the text.

Thank you.

[lucas]

Use a picture in the same folder as the excel file as your background and have it say Draft or whatever:

In your thisworkbook module:

Option Explicit
Private Sub Workbook_Open()
ActiveSheet.SetBackgroundPicture ThisWorkbook.Path & ("\image1.jpg")
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ActiveSheet.SetBackgroundPicture ("")
ActiveWorkbook.Save
End Sub

See attached zip. Extract excel file and .jpg to same folder and run the excel file.

[lucas]

or just use a picture such as the above for your background.