2017-11-13 1 views
0

コメントボックスに暗記する機能があります。時刻は&です。誰がセルを変更したのか、最後の5つの変更をメモリに保存しています。 6番目の変更が行われたときは、最も古いものを削除し、最新の時刻を印刷しています。私はまた、コードでコメントボックスのフォーマットを定式化しています。VBAを書いているコメントボックス

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

関連する問題