CODEWITHSUNDEEP
excelvba
BenW
BenW

Reputation: 1

Editing a comment and retaining formatting using VBA

I have a workbook where i am comparing two worksheets that should be identical for the most part, including comments. When there is a difference, I am marking the cell yellow in the main sheet and then creating a formatted comment with details on what is different. That cell will now have BOTH comments.

As many of the cells have formatted comments already, I have created a function that inserts a new comment at the end of an existing comment and keeps the formatting of both comments.

Below is the code for what i have. This would be called after i compare the comment text of the two fields and determine they are different.

The code seems to work fine. However copying one character at a is inefficient. I would be able to insert the comment with something like TF.Characters(TF.Characters.Count+1).Insert (DiffR.Comment.text). But how can i copy over the font structure for the bold and size formatting of the comment with a single statement using SOMETHING LIKE TF.Characters(start position before the copy,start position before the copy + copytf.characters.count).Font = CopyTF(0,copytf.characters.count).font? This doesn't seem to work...

Public Sub AddDifferentComment(R As Range, DiffR As Range)
Dim TF As TextFrame, CopyTF As TextFrame, theChar As String
Dim SeparatorStr As String
Dim i As Integer

SeparatorStr = Chr(10) & "---------------------------" & Chr(10)


Set TF = R.Comment.Shape.TextFrame
Set CopyTF = DiffR.Comment.Shape.TextFrame

TF.Characters(TF.Characters.Count).Insert (SeparatorStr)

For i = 1 To CopyTF.Characters.Count
    theChar = CopyTF.Characters(i, 1).text
    TF.Characters(TF.Characters.Count + 1).Insert (theChar)
    TF.Characters(TF.Characters.Count).Font.Bold = CopyTF.Characters(i, 1).Font.Bold
    TF.Characters(TF.Characters.Count).Font.Size = CopyTF.Characters(i, 1).Font.Size
Next i
End Sub

Another way to view this is: Is there an efficient way to make one comment equal to FORMATTED comments of two different cells, concatenated?

I also tried to do this with storing arrays of characters as the format changed, which works but is surprisingly slow when i review the character by character. If this could be sped up it would be fine.

Public Sub GetFormattedStringsFromComment(R As Range, ByRef strCommentA() As String, ByRef bBoldA() As Boolean, ByRef theSizeA() As Integer, ArrayCount As Integer)
Dim TF As TextFrame
Dim i As Integer, bLastBold As Boolean, LastSize As Integer, bNewFormat As Boolean, theStr As String

    If Not HasComment(R) Then Exit Sub

    i = -1
    Do While strCommentA(i + 1) <> ""
        i = i + 1
    Loop
    ArrayCount = i

    Set TF = R.Comment.Shape.TextFrame
    For i = 1 To TF.Characters.Count
        If i > 1 Then
            'Check to see if it is a changed format and if so add to the arrays
            If bLastBold <> TF.Characters(i, 1).Font.Bold Or LastSize <> TF.Characters(i, 1).Font.Size Then
                ArrayCount = ArrayCount + 1
                strCommentA(ArrayCount) = theStr
                bBoldA(ArrayCount) = bLastBold
                theSizeA(ArrayCount) = LastSize
                theStr = ""
            End If
        End If
        theStr = theStr & TF.Characters(i, 1).text
        bLastBold = TF.Characters(i, 1).Font.Bold
        LastSize = TF.Characters(i, 1).Font.Size
    Next i
    ArrayCount = ArrayCount + 1
    strCommentA(ArrayCount) = theStr
    bBoldA(ArrayCount) = bLastBold
    theSizeA(ArrayCount) = LastSize
End Sub

Upvotes: 0

Views: 1022

Answers (1)

paul bica
paul bica

Reputation: 10715

This changes all new characters at once (if the new comment is only one font size, and Bold)

Option Explicit

Public Sub AddDifferentComment(ByRef toRng As Range, ByRef newRng As Range)
    Dim toTxt As TextFrame, newTxt As TextFrame, newStart As Long, divLine As String

    divLine = Chr(10) & "---------------------------" & Chr(10)

    Set newTxt = newRng.Comment.Shape.TextFrame
    Set toTxt = toRng.Comment.Shape.TextFrame

    newStart = toTxt.Characters.Count + Len(divLine) + 1

    toRng.Comment.Text divLine & newTxt.Characters.Text, newStart

    With toTxt.Characters(newStart, newTxt.Characters.Count + 1).Font
        .Size = newTxt.Characters.Font.Size
        .Bold = newTxt.Characters.Font.Bold
    End With
End Sub

I haven't measured it but it's probably faster

Upvotes: 1

Related Questions