2017-11-13 1 views
0

그래서, 코멘트 박스에 기억하고있는 기능이 아래와 같습니다. &의 날짜와 사용자 이름은 누가 셀을 변경했는지, 마지막 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 
+0

당신은 당신의 코멘트의 내용을 복사 시도하고 헤더에 주석을 추가 할 수 있습니다. –

답변

2

가 선언 이 같은 공공 상수 :

Public Const UPDATED_ON = "UPDATED ON" & vbCrLf 

당신이 마지막에 주석을 작성,이 같은 아무것도 UPDATED_ON의 값을 대체하려고 :

끝에
FinalComment = Replace(FinalComment, UPDATED_ON, vbNullString) 

는 다음과 같이 상단에 UPDATED_ON을 추가

FinalComment = UPDATED_ON & FinalComment 
+0

감사합니다. 더 복잡한 방식으로 생각하고있었습니다. 성공하면 솔루션을 게시 할 것입니다. – USER7423