Mehrere Aenderungen automatisch als Kommentar

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub Target.ClearComments Target.AddComment.Text Text:="Previous Value was " & preValue & Chr(10) & "Revised " & _ Format(Date, "mm-dd-yyyy") & Chr(10) & "By " & Environ("UserName") End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Jan,
ich habe eine Teillösung, die ALLE Änderungen im Kommentar listet. Das auf 4 oder 5 zu beschränken wäre jetzt sehr aufwendig (fehlt mir grad auch die Idee). Vielleicht reicht es ja, wenn du alle paar Wochen die Kommentare löscht (also zurück setzt).
Ich habe den Kommentar leicht verändert und neben dem Datum auch die Uhrzeit anzeigen lassen. Erscheint mir sinnig. Wenn du nur das Datum willst, kommentierst du meine Version aus und die alte Version wieder ein, ich hab die Zeile stehen gelassen.
Ganz genau genommen "gehört" in eine Worksheet-Change Anweisung kein so langer Code. Den sollte man in ein Modul auslagern und in Worksheet-Change nur aufrufen, damit das übersichtlich bleibt. Willst du in Zukunft noch ein halbes dutzend Makros OnChange aufrufen, wird es arg unübersichtlich wenn du die alle direkt im Ereignis stehen hast. Das habe ich jetzt NICHT geändert, das ist Fleißarbeit die du selbst machen darfst.
Was ich geändert habe: das EXIT SUB rausgeworfen und stattdessen den Code in einen IF-THEN-ELSE Schleife gepackt. Auf EXIT SUB solltest du möglichst verzichten. Beispiel: nächste Woche fügst du weiteren Code in die Prozedur ein, der mehrzellig arbeitet. Aus Faulheit kopierst du ihn einfach unter den Kommentar-Code: der Funktioniert ja bereits und muss nicht wieder betrachtet werden! Das "Exit Sub" verhindert jetzt die Ausführung deines neuen Codes ... und wenn du das nach ein paar Stunden debugging herausfindest, beisst du dir selbst in den Allerwertesten!
So, genug erhobener Zeigefinger. Hier der neue Code:

Option Explicit
Public preValue As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sCommentOld As String
If Target.Count > 1 Then    ' Exit Sub // siehe Kommentar Beitrag
'mache gar nichts!
Else
sCommentOld = ""     'Variable leeren
On Error Resume Next 'falls kein kommentar vorhanden, nächste Zeile überspringen
sCommentOld = Target.Comment.Text '"alten" Kommentartext merken
On Error GoTo 0      'Fehlerbehandlung wieder an
Target.ClearComments 'Kommentar der Zeile löschen
'Wenn benötigt, Absätze einfügen zwecks besserer Lesbarkeit
If Not sCommentOld = "" Then sCommentOld = sCommentOld & Chr(10) & Chr(10)
'Nur Datum, wie im original
'Target.AddComment.Text Text:=sCommentOld & Chr(10) & Chr(10) & "Previous Value was " &  _
preValue & Chr(10) & "Revised " & _
Format(Date, "mm-dd-yyyy") & Chr(10) & "By " & Environ("UserName")
'Mit Datum und ZEIT
Target.AddComment.Text Text:=sCommentOld & "Previous Value was: " & preValue & Chr(10) & _
"Revised " & _
Format(Now, "mm-dd-yyyy hh:mm") & Chr(10) & "By " & Environ("UserName")
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target = "" Then
preValue = "a blank"
Else: preValue = Target.Value
End If
End Sub

Grüße,
Klaus M.vdT.

Option Explicit Dim oldValue Private Sub Worksheet_Change(ByVal Target As Range) Dim strC As String, arrA, arrN(), ii As Long, strN As String ' Trennzeile: Const sTZ As String = vbLf & "---------------------------" & vbLf Const iAnz As Integer = 5 ' Anzahl Einträge im Kommentar With Target If .Count > 1 Then Exit Sub strN = "Prev. Value: " & oldValue & Chr(10) & "Revised " & _ Format(Now, "mm-dd-yyyy hh:mm:ss") & " by " & Environ("UserName") If .Comment Is Nothing Then .AddComment.Text strN: Exit Sub End If If .Comment.Text = "" Or iAnz = iAnz - 1 Then ReDim arrN(0 To iAnz - 2) For ii = 0 To iAnz - 2 arrN(ii) = arrA(ii + iAnz - UBound(arrN) - 1) Next ii strC = Join(arrN, sTZ) Else strC = .Comment.Text End If strC = strC & sTZ & strN End If .Comment.Text strC End With End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) With Target If .Count > 1 Then Exit Sub oldValue = IIf(.Value = "", "a blank", .Value) End With End Sub

Beliebteste Forumthreads (12 Monate)

Mehrere Aenderungen automatisch als Kommentar

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread