Create & Format XL Comments with VBA

[AH·C]

XL2003

I'm trying to take the formatted text of a cell and put it into a
comment.

While it would be cool to format the colors, size and any other options
that goes with Edit Comment | Format Comment, I would be satisfied to
simply have the first line bold.

Example of Stock Codes:
Cell B1 = "*Local Stock:*
Parts are on-hand"
Cell B2 = "*Manufacturer Ship:*
Parts ordered are shipped
directly by Manufacturer" ... etc

I'm using SELECT CASE code to determine my stock code which in turns
points to the cell to be copied into the comment.

---------------
Select Case rcStr ' Evaluate Stock Code.
Case "A"
commentText = Index.Range("B1").Text
Case "B"...
commentText = Index.Range("B2").Text
Case "C"...etc
End Select

On Error Resume Next
ws.Cells(niinRow, 6).AddComment
With ws.Cells(niinRow, 6).Comment
..Visible = False
..Text Text:=commentText
..Shape.TextFrame.AutoSize = True
' code here to bold the first line, or
End With
' code here to bold the first line?
----------

So far, the code works fine in that it replicates the linebreaks as
entered on the source cells. I'm almost positive that I've seen an
example from somewhere a few years ago that handles formatting, but now
that I need it ...

I'm thinking this may involve using FIND, LEN and or LEFT to locate
where the first soft line break [Alt+Enter] and bold the string prior
to it. But I've got zilch from searching archives and experimenting in
this direction.

TIA

 

[Tom Ogilvy]

Use the characters object to format character by character or to format a
subset of characters.

For an illustration, turn on the macro recorder and then format individual
characters in a cells.

You can adapt it to your textframe as well.

 

[AH·C]

Tom, thanks for pointing me in the right direction.

Took me a while to figure out what was part of which group, then more
time to tighten the code as much as possible.

Anyway, I hope others may find it useful -- save themselves some of the
hassle in solving this -- so here goes.
Note: -If there is a way to indent, I'm sorry . From the
VBE, I substitued the tabs with a PIPE & SPACE ("| ") in hopes of
maintaining some semblence of order, especially since there are nests
within nests.-

Sub AACode()
Set thisAACCount = Dash1.Range("G$15:G" & niinRow)
Dim aacStr As String, aacCell As Range, commentText As String,
thisAACCount As Range
| If Application.WorksheetFunction.CountIf(thisAACCount, Cells(niinRow,
7).Value) = 1 Then 'is value the 1st instance?
| | | 'then add and format comment
| | On Error Resume Next
| | Select Case aacStr ' Evaluate Stock Code.
| | | Case "A"
| | | | commentText = SheetMaster.Range("P67").Text
'=======Sample Text=====
'*NOT STOCKED, CENTRALLY PROCURED, LONG LEAD·*
'IMM/Service centrally managed but not stocked item. Procurement
' will be initiated only after receipt of a requisition.
'======End Sample Text===
| | | Case "B"
| | | | commentText = SheetMaster.Range("P68").Text
| | | Case "Z"
| | | | commentText = SheetMaster.Range("P92").Text
| | End Select
|
| | 'On Error Resume Next
| | Dim aacEOL As Long
| | aacEOL = Application.WorksheetFunction.Find("·", commentText, 1) '
to find position of the last char on 1st line -- see Sample Text above
| | Dash1.Cells(niinRow, 7).Comment.Delete 'Clear any comments
| | Dash1.Cells(niinRow, 7).AddComment
| | With Dash1.Cells(niinRow, 7).Comment
| | | .Visible = False
| | | .Text Text:=commentText
| | | With .Shape 'format entire comment
| | | | .Fill.Visible = msoTrue
| | | | .Fill.Visible = msoTrue
| | | | .Fill.Solid
| | | | .Fill.ForeColor.SchemeColor = 42 '42 = LightGreen, 27 =
LightTurquoise
| | | | .Fill.Transparency = 0#
| | | | .Line.Weight = 0.75
| | | | .Line.DashStyle = msoLineSolid
| | | | .Line.Style = msoLineSingle
| | | | .Line.Transparency = 0#
| | | | .Line.Visible = msoTrue
| | | | .Line.ForeColor.SchemeColor = 10
| | | | .Line.BackColor.RGB = RGB(255, 255, 255)
| | | | .TextFrame.MarginLeft = 3.6
| | | | .TextFrame.MarginRight = 3.6
| | | | .TextFrame.MarginTop = 3.6
| | | | .TextFrame.MarginBottom = 3.6
| | | | .TextFrame.AutoSize = True
| | | | .TextFrame.HorizontalAlignment = xlLeft
| | | | .TextFrame.VerticalAlignment = xlTop
| | | | .TextFrame.ReadingOrder = xlContext
| | | | .TextFrame.Orientation = xlHorizontal
| | | | .TextFrame.AutoSize = True
| | | | .TextFrame.HorizontalAlignment = xlLeft
| | | | .TextFrame.VerticalAlignment = xlTop
| | | | .TextFrame.ReadingOrder = xlContext
| | | | .TextFrame.Orientation = xlHorizontal
| | | | With .TextFrame.Characters.Font
| | | | | .Name = "Tahoma"
| | | | | .FontStyle = "Regular"
| | | | | .Size = 8
| | | | | .Strikethrough = False
| | | | | .Superscript = False
| | | | | .Subscript = False
| | | | | .OutlineFont = False
| | | | | .Shadow = False
| | | | | .Underline = xlUnderlineStyleNone
| | | | | .ColorIndex = 5 'Blue
| | | | End With
| | | | With .TextFrame.Characters(Start:=1, Length:=aacEOL).Font '1st
line is bold & darkblue
| | | | | .Name = "Arial"
| | | | | .FontStyle = "Bold"
| | | | | .ColorIndex = 11 'DarkBlue
| | | | End With
| | | End With
| | End With
| End If
|
| | 'Reformat Cell for hi-lite/emphasis
| If aacStr <> "" Then 'True or False, if True...
| | aacStr = UCase(aacStr)
| | Select Case aacStr| ' Evaluate text.
| | | Case "B", "F", "L", "M", "N", "R", "S", "U", "W", "Y" ' "SPECIAL"
ACTIONS REQ'D. Cannot order w/o higher authorization
| | | With aacCell 'RED font on LIGHTYELLOW
| | | | .Font.Name = "Arial Black"
| | | | .Font.FontStyle = "Bold"
| | | | .Font.ColorIndex = 3
| | | | .Interior.ColorIndex = 19
| | | | .Interior.Pattern = xlSolid
| | | | .Interior.PatternColorIndex = 2
| | | End With
|
| | | Case "P", "T" ' "NO", absolutely cannot order, must find
alternative
| | | With aacCell 'YELLOW font on RED
| | | | .Font.Name = "Arial Black"
| | | | .Font.FontStyle = "Bold"
| | | | .Font.ColorIndex = 6
| | | | .Interior.ColorIndex = 3
| | | | .Interior.Pattern = xlSolid
| | | | .Interior.PatternColorIndex = 2
| | | End With
|
| | | Case "A", "O", "V", "X", "Z" ' "LONG LEAD", be prepared to wait
for delivery
| | | With aacCell 'BLUE font on LIGHTGREEN
| | | | .Font.Name = "Arial Black"
| | | | .Font.FontStyle = "Bold"
| | | | .Font.Size = 8
| | | | .Font.ColorIndex = 5
| | | | .Interior.ColorIndex = 20
| | | | .Interior.Pattern = xlSolid
| | | | .Interior.PatternColorIndex = xlAutomatic
| | | End With
| | End Select
| End If
| aacEOL = 0
| aacStr = ""
| commentText = ""
End Sub

Again, thanks a million. And have a Happy New Year!!!