그래서, 코멘트 박스에 기억하고있는 기능이 아래와 같습니다. &의 날짜와 사용자 이름은 누가 셀을 변경했는지, 마지막 5 가지 변경 사항을 메모리에 유지합니다. 여섯 번째 변경이 이루어지면 가장 오래된 것을 삭제하고 가장 최근의 시간을 인쇄합니다. 나는 또한 코드로 주석 상자의 형식을 형성하고있다.VBA formating 코멘트 박스
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
당신은 당신의 코멘트의 내용을 복사 시도하고 헤더에 주석을 추가 할 수 있습니다. –