VBA格式化评论框

时间:2017-11-13 15:42:42

标签: excel vba excel-vba

所以,我有一个记忆在评论框中的功能,时间和日期以及谁在单元格中进行了更改的用户名,在内存中保留了最后5个更改。进行第六次更改时,删除最旧的一次,并打印最新的时间。我也在用代码格式化注释框的格式。

    Private Sub Worksheet_Change(ByVal Target As Range)

    Dim CommentBox As Object
    Dim CommentString As String
    Dim CommentTemp As String
    Dim LastDoubleDotPosition As Integer
    Dim LongestName As Integer
    Dim FinalComment As String


   If Range("A" & Target.Row).Value = "" Then GoTo EndeSub
   If Target.Row <= 2 Then GoTo EndeSub
   If Not Intersect(Range("C:JA"), Target) Is Nothing Then
     On Error GoTo EndeSub
     Application.EnableEvents = False
     Range("B" & Target.Row) = Now
   End If

    Application.Volatile

    Set CommentBox = Range("B" & Target.Row).Comment

    If Not CommentBox Is Nothing Then
        If CommentBox.Text <> "" Then
            CommentString = CommentBox.Text
            Range("B" & Target.Row).Comment.Delete
        End If
    Else
        CommentString = ""
    End If

    CommentTemp = CommentString
    LastDoubleDotPosition = 0
    LongestName = 0

    If InStr(CommentTemp, ":") > 0 Then StillTwoDoubleDots = True

    Do While InStr(CommentTemp, ":") > 0

        If InStr(CommentTemp, ":") > LongestName Then LongestName = InStr(CommentTemp, ":")
        CommentTemp = Right(CommentTemp, Len(CommentTemp) - InStr(CommentTemp, ":"))

    Loop

    count = CountChr(CommentString, ":")

    If count >= 6 Then

        LastDoubleDotPosition = Len(CommentString) - Len(CommentTemp) - 1
        CommentString = Left(CommentString, LastDoubleDotPosition - 13)

    End If

    'insert comment
    FinalComment = Format(Now(), "DD.MM.YYYY hh:mm") & " " & "by" & " " & Application.UserName & vbCrLf & CommentString 'newComment and the oldcomment
    FinalComment = Replace(FinalComment, CustomComment, vbNullString)
    FinalComment = CustomComment & FinalComment
    Range("B" & Target.Row).AddComment FinalComment

    Set CommentBox = Range("B" & Target.Row).Comment

    LongestName = LongestName * 5
    If LongestName < 150 Then LongestName = 150

    With CommentBox
        .Shape.Height = 70
        .Shape.Width = LongestName
    End With


EndeSub:
    Application.EnableEvents = True

End Sub


Public Function CountChr(Expression As String, Character As String) As Long

    Dim Result As Long
    Dim Parts() As String
    Parts = Split(Expression, Character)
    Result = UBound(Parts, 1)
    If (Result = -1) Then
    Result = 0
    End If
    CountChr = Result

End Function

您是否认为还可以为该评论框添加标题?例如,现在我有以下输出:

13.11.2017 17:39 by user2

13.11.2017 17:35 by user1

13.11.2017 17:35 by user3

13.11.2017 17:34 by user1

13.11.2017 17:33 by user1

我想添加一个粗体标题,让我们说:“更新于:”,输出结果如下:

Updated on:

    13.11.2017 17:39 by user2

    13.11.2017 17:35 by user1

    13.11.2017 17:35 by user3

    13.11.2017 17:34 by user1

    13.11.2017 17:33 by user1

1 个答案:

答案 0 :(得分:1)

声明一个像这样的公共常量:

Public Const UPDATED_ON = "UPDATED ON" & vbCrLf

当您在最后写评论时,尝试将UPDATED_ON的值替换为以下内容:

FinalComment = Replace(FinalComment, UPDATED_ON, vbNullString)

最后在顶部添加UPDATED_ON,如下所示:

FinalComment = UPDATED_ON & FinalComment