Редактирование комментария и сохранение форматирования с использованием VBA

Question

У меня есть рабочая тетрадь, в которой я сравниваю две таблицы, которые по большей части должны быть идентичными, включая комментарии.Когда есть разница, я отмечаю желтую ячейку на основном листе, а затем создаю отформатированный комментарий с подробной информацией о том, что отличается.Эта ячейка теперь будет иметь ОБА комментарии.

Поскольку многие ячейки уже отформатировали комментарии, я создал функцию, которая вставляет новый комментарий в конец существующего комментария и сохраняет форматирование обоих комментариев.

Ниже приведен код того, что у меня есть.Это будет вызвано после того, как я сравню текст комментария двух полей и определю, что они разные.

Код, кажется, работает нормально.Однако копирование одного символа в a неэффективно.Я мог бы вставить комментарий с чем-то вроде TF.Characters (TF.Characters.Count + 1) .Insert (DiffR.Comment.text).Но как я могу скопировать структуру шрифта для полужирного и размерного форматирования комментария с помощью одного оператора, используя SOMETHING LIKE TF.Characters (начальная позиция перед копией, начальная позиция перед копией + copytf.characters.count) .Font =CopyTF (0, copytf.characters.count) .font?Кажется, это не работает ...

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

Еще один способ посмотреть на это: есть ли эффективный способ сделать один комментарий равным ФОРМАТИРОВАННЫМ комментариям двух разных ячеек, объединенным?

Я также попытался сделать это с сохранением массивов символов при изменении формата, что работает, но удивительно медленно, когда я просматриваю символ за символом.Если бы это можно было ускорить, было бы хорошо.

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

Answer 1

Это изменяет все новые символы одновременно (если новый комментарий имеет только один размер шрифта и жирный шрифт)

---

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

---

Я не измерял его, но, вероятно, он быстрее