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

另一种观察方式是：是否有一种有效的方法可以使一个注释等同于两个不同单元格的FORMATTED注释，连接？

我还尝试将这些字符数组存储为格式更改，但是当我逐字逐句查看字符时，这种情况非常慢。如果这可以加快，那就没关系了。

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

我还没有测量过，但它可能更快

使用VBA编辑评论并保留格式

1 个答案: