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.

--
Regards,
Tom Ogilvy


"AH·C" <[email protected]> wrote in message
news:[email protected]...
>
> 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
>
>
> --
> AH·C
> ------------------------------------------------------------------------
> AH·C's Profile:
http://www.excelforum.com/member.php...o&userid=29108
> View this thread: http://www.excelforum.com/showthread...hreadid=496363
>

[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!!!