Adding Text and Color to a Note Box

Bright01 used Ask the Experts™
EE Pros,

I have this really cool macro that EE Pros helped me with.  I have two simple adds I'd like to put into the Macro.

1.) When you show the Text Box, I'd like it to have the word "NOTES:" show up first on the primary line.  
2.) I'd like the Text Box for NOTES to have a YELLOW Background.

Thank you,

Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Mechanical Engineer
Most Valuable Expert 2013
Top Expert 2013
I wrote sub NotesFormatter to apply the yellow background color, and add TEXT: to your textbox. For grins, I made TEXT: 18 point and blue, while the balance of text is 11 point and black. I also changed your existing sub ShowTextBox to call NotesFormatter and to set the width of the textbox to 150 rather than your value of 10.
Sub ShowTextBox()
Dim shp As Shape
Dim ws As Worksheet
Dim wn As Window
Dim sngHeight As Single, sngLeft As Single, sngTop As Single, sngWidth As Single

Set ws = ActiveSheet
On Error Resume Next
Set shp = ws.Shapes("Notes")
On Error GoTo 0
Set wn = Application.ActiveWindow
sngLeft = wn.Left + ws.Cells(wn.ScrollRow, wn.ScrollColumn).Left + wn.Width * 0.5
sngWidth = 150
sngTop = wn.Top + ws.Cells(wn.ScrollRow, wn.ScrollColumn).Top + wn.Height / 8
sngHeight = 800

'ws.Protect Password:="jam", userinterfaceonly:=True, DrawingObjects:=False
'ActiveSheet.Unprotect Password:="jam"

If shp Is Nothing Then
    Set shp = ws.Shapes.AddTextbox( _
        Orientation:=msoTextOrientationHorizontal, Left:=sngLeft, Top:=sngTop, Width:=sngWidth, Height:=sngHeight)
    shp.Name = "Notes"
    shp.Top = sngTop
    shp.Left = sngLeft
    shp.Visible = msoTrue
End If

shp.TextFrame2.AutoSize = msoAutoSizeShapeToFitText

NotesFormatter shp
'Selection.PrintObject = 0

'Selection.PrintObject = msoFalse

End Sub

Sub NotesFormatter(shp As Shape)
Dim s As String

With shp.Fill
    .Visible = msoTrue
    .ForeColor.RGB = RGB(255, 255, 0)
    .Transparency = 0
End With

With shp.TextFrame
    s = .Characters.Text
    If Len(s) > 5 Then
        If UCase(Left(s, 5)) <> "TEXT:" Then s = "TEXT:" & vbLf & s
        s = "TEXT:" & vbLf & " "
    End If
    .Characters.Text = s
    .Characters(1, 5).Font.Size = 18
    .Characters(1, 5).Font.ColorIndex = 23
    .Characters(6, Len(s) - 5).Font.Size = 11
    .Characters(6, Len(s) - 5).Font.ColorIndex = 1
End With
End Sub

Open in new window




Great!  Fastest solution I've ever had returned!  Integrated it tonight.  I am following up with you tomorrow.

Hope you had a great Easter!


Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial