Code funktioniert mir fehlen aber noch 2 Punkte
geri
Code klappt wunderbar hätte aber noch gerne integriert ... kann nicht mehr soviel sein was fehlt
a. letzte Zellinhalt in Kommentar
b. das sich Kommentarfeld wenn mögich der Zextgrösse anpasst
DANKE
Geri
Gruss aus CH
Option Explicit
'********************************************************
Private Function AenderungskennungAlsKommentar(r As Range)
'*** für die geänderte Zelle wird im Kommentar
'*** Benutzerkennung und Änderungszeitpunkt
'*** eingetragen
'*** Ist kein Kommentar vorhanden, wird ein neuer angelegt
Dim S As String, s_user As String
Dim office As String
'ggf. vorhandenen Kommentar lesen
On Error Resume Next
S = r.Comment.Text
If Err.Number 0 Then
Err.Clear
'neuen Kommentar anlegen
r.AddComment
r.Comment.Visible = False
S = ""
End If
On Error GoTo 0
'Wenn Kommentar vorhanden, Zeilenumbruch anfügen
If S "" Then S = S & vbLf
'Letzten Benutzer feststellen
's_user = ActiveWorkbook.BuiltinDocumentProperties(7)
office = Environ("Username")
'Datum und Benutzer an Kommentar anfügen
S = S & Format(Now(), "yyyymmdd_hhnn: ") & office
'Kommentar eintragen
r.Comment.Text S
End Function
Private Sub Worksheet_Change(ByVal Target As Range)
'
Private Sub Worksheet_Change(ByVal Sh As Object, ByVal Target As Excel.Range)
Dim r As Range
'If Sh.Name = "Aenderungsjournal" Then
'Für jede geänderte Zelle
For Each r In Target
'Wenn Spalte A oder B
If (r.Column = 9) Or (r.Column = 10) Then
'dann Kommentar eintragen
Call AenderungskennungAlsKommentar(r)
End If
Next
Set r = Nothing
End Sub