Automatisches Kommentarfeld?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

geht recht einfach...
den vbe (vba editor) aufmachen bspw. mit strg + F11.
dann unter microsoft excel objekte und wiederum diese arbeitsmappe kannst du ein sub "Worksheet_Change(ByVal Target As Excel.Range)" erstellen. (oben in der ersten auswahlbox auf workbook und dann in der 2. auf change)
das target ist dann die aktuelle zelle (bzw. mehrere, wenn viele ausgewählt sind).
in dieses sub schreibst du dann:
'sicherheitshalber, da eine mehrfachauswahl probleme beim makrolauf machen könnte. man könnte aber auch mehrfachauswahl abfangen...
if target.count > 1 then exit sub
'vorsichtshalber vorherigen commi löschen. man könnt aber auch fortschreiben und den letzten immer oben dran packen, bis irgendwann mal zu viel text im kommentar ist...
on error resume next
Target.Comment.delete
on error goto 0
Target.AddComment (Environ("USERNAME"))

Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo Fehler Dim Z, RNG As Range Set RNG = Range("A1:E100") If Not Intersect(RNG, Target) Is Nothing Then If Target.Row <= 1 Then Exit Sub 'wegen Überschrift For Each Z In Target If Z <> "" Then With Z .ClearComments .AddComment .Comment.Visible = False .Comment.Text Text:=Environ("Username") End With End If Next End If '*** Fehlerbehandlung Err.Clear Fehler: Application.EnableEvents = True If Err.Number <> 0 Then MsgBox "Fehler: " & _ Err.Number & vbLf & Err.Description: Err.Clear End Sub

Hallo Thomas,

' **********************************************************************
' Modul: Tabelle1  Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim objRange As Object, objChange As Range

On Error Resume Next
Set objChange = Intersect(Target, Me.UsedRange)
On Error GoTo 0

If Not objChange Is Nothing Then
  For Each objRange In objChange
    If objRange = "" Then
      Call addComment(objRange, Now, Environ("USERNAME"), "Daten gelöscht!")
      'oder
      'Call addComment(objRange, , , , True)
    Else
      Call addComment(objRange, Now, Environ("USERNAME"), "Daten geändert!")
    End If
  Next
End If

End Sub

Private Sub addComment(ByRef Target As Range, Optional ByVal changedOn As Date, Optional ByVal User As String, Optional ByVal Message As String, Optional ByVal Delete As Boolean = False)
Dim strMsg As String

strMsg = Message & vbLf & vbLf & "Geändert am:" & String(4, " ") & Format(changedOn, "yyyy.MM.dd hh:mm:ss") & _
  vbLf & "Geändert von:" & String(3, " ") & User
With Target
  .ClearComments
  If Not Delete Then
    .addComment strMsg
    With .Comment.Shape
      .TextFrame.AutoSize = True
      .Fill.ForeColor.RGB = RGB(175, 175, 175)
    End With
  End If
End With
End Sub

Gruß Sepp

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) Dim RNG As Range Set RNG = Range("A1:E100") If Not Intersect(RNG, Target) Is Nothing Then Cancel = True End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo Fehler Dim Z, RNG As Range Set RNG = Range("A1:E100") If Not Intersect(RNG, Target) Is Nothing Then If Target.Row <= 1 Then Exit Sub 'wegen Überschrift For Each Z In Target With Z If .Value <> "" Then .ClearComments .AddComment .Comment.Visible = False .Comment.Text Text:=Format(Date, "DD.MM.YYYY: ") & Environ("Username") Else .ClearComments .AddComment .Comment.Visible = False .Comment.Text Text:=Format(Date, "DD.MM.YYYY: ") & "gelöscht von " & Environ("Username") End If End With Next End If '*** Fehlerbehandlung Err.Clear Fehler: Application.EnableEvents = True If Err.Number <> 0 Then MsgBox "Fehler: " & _ Err.Number & vbLf & Err.Description: Err.Clear End Sub

Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo Fehler Dim Z, RNG As Range Set RNG = Range("A1:E100") If Not Intersect(RNG, Target) Is Nothing Then If Target.Row <= 1 Then Exit Sub 'wegen Überschrift For Each Z In Target With Z .ClearComments If .Value <> "" Then .AddComment .Comment.Visible = False .Comment.Text Text:=Format(Date, "DD.MM.YYYY: ") & Environ("Username") End If End With Next End If '*** Fehlerbehandlung Err.Clear Fehler: Application.EnableEvents = True If Err.Number <> 0 Then MsgBox "Fehler: " & _ Err.Number & vbLf & Err.Description: Err.Clear End Sub

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Automatisches Kommentarfeld?

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread