Änderungsdatum von Zellen automatisiert im Kommentar vermerken

[Rabe]

Hi,

Wenn ich folgende Datei in der das Makro laufen soll als *.xlsm abspeichere...:

in der Datei sind seeeehr viele Menüpunkte nicht anwählbar!

[Frank BST]

Ja eben.

Ich habe ganz normal ein Standard Arbeitsblatt erstellt und mit Daten befüllt.
Keine Formeln.
Etwas Formatierung.

Gruß Frank

[Rabe]

Hi Frank,

dann teste es mal mit diesen Dateien. Ich habe den Inhalt, die Formatierung und die Spaltenbreite in eine neue Datei kopiert und abgespeichert.

  Neue Projekte.xlsx (Größe: 13,55 KB / Downloads: 7)

  Neue Projekte.xlsm (Größe: 13,56 KB / Downloads: 2)

  Neue Projekte.xlsb (Größe: 11,06 KB / Downloads: 1)

[Frank BST]

Oh Sorry Ralf, das hätte ich erwähnen sollen.


So in der Art habe ich mir bereits selbst geholfen.

Ich wollt eher wissen warum gerade in dieser Datei so viele 'Schalter' gesperrt sind.


Aber Danke für die Mühe

Gruß Frank

[Frank BST]

Hallo

Wie bewirke ich das nur Änderungen notiert werden in den Range'es "F2:H40" und "J2:S40"?

Mit der Zeile habe ich mir grob geholfen:

Code:

If (r.Column = 6) Or (r.Column = 7) Or (r.Column = 8) Or (r.Column = 10) Or (r.Column = 11) Or (r.Column = 12) Or (r.Column = 13) Or (r.Column = 14) Or (r.Column = 15) Or (r.Column = 16) Or (r.Column = 17) Or (r.Column = 18) Or (r.Column = 19) Then

Im ganzen Kontext:

Code:

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Dim r As Range
'->Für jede geänderte Zelle
 For Each r In Target

  '->Wenn Spalte A oder B
   If (r.Column = 6) Or (r.Column = 7) Or (r.Column = 8) Or (r.Column = 10) Or (r.Column = 11) Or (r.Column = 12) Or (r.Column = 13) Or (r.Column = 14) Or (r.Column = 15) Or (r.Column = 16) Or (r.Column = 17) Or (r.Column = 18) Or (r.Column = 19) Then
   '->dann Kommentar eintragen

     Call AenderungskennungAlsKommentar(r)

   End If
Next
Set r = Nothing
End Sub

'********************************************************
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
'->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)
'->Datum und Benutzer an Kommentar anfügen
s = s & Format(Now(), "yyyy.mm.dd_hh:nn ") & "Uhr" & s_user
'->Kommentar eintragen
r.Comment.Text s
End Function

VG
Frank

[RPP63]

Hi Frank!

Wie bewirke ich das nur Änderungen notiert werden in den Range'es "F2:H40" und "J2:S40"?

Ganz einfach so:

Code:

If Not Intersect(r, Range("F2:H40,J2:S40")) Is Nothing Then
   'Code
End If

Gruß Ralf

[Frank BST]

Moin,

woran liegt das, dass diese Excel Datei mit dem integrierten Makro für Minuten einfriert wenn ich Zeilen oder Spalten lösche oder hinzufüge?
Die Daten sind nicht verloren. Excel braucht nur viel Zeit zum ausführen.
Das geschieht auch wenn die bearbeiteten Spalten nicht durch die markierte 'Range' gehen.
Der Taskmanager zeigt eine 25%ige CPU Auslastung meiner Quad CPU.
Um so mehr Spalten es betrifft um so länger rechnet Excel

VG
Frank

[RPP63]

Moin!
Wenn mein Programmierer mich zwingen würde, 1.048.576 Kommentare zu schreiben, nur weil ich eine Spalte lösche, würde ich gar nicht erst anfangen!  :19:
Eigentlich müsstest Du diese Fragen ja den "Fachleuten" von Winforum stellen, schließlich haben die ja diesen Murks geschrieben.
Dennoch:
Dein überwachter Bereich umfasst 3+10 Spalten und 39 Zeilen.
Dies musst Du dem Workbook_SheetChange als Ausstiegskriterium angeben!
In die erste Zeile des Workbook_SheetChange:

Code:

If Target.Columns.Count > 13 Or Target.Rows.Count > 39 Then Exit Sub

Gruß Ralf

[Frank BST]

Supi Ralf,

läuft wie schnuff.
Nachdem mein Atom Prozessor nun über ne Stunde gebraucht hat um die Datei wieder zur Bearbeitung freizugeben.

Code:

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Dim r As Range
'->Für jede geänderte Zelle
If Target.Columns.Count > 13 Or Target.Rows.Count > 39 Then Exit Sub
 For Each r In Target

  '->Wenn Spalte A oder B
   If Not Intersect(r, Range("E2:G39,I2:R39")) Is Nothing Then
   '->dann Kommentar eintragen

     Call AenderungskennungAlsKommentar(r)

   End If
Next
Set r = Nothing
End Sub

[Frank BST]

Hallo,

mein Problem lebt wieder.

Es ist mir eine weitere Ungereimtheit aufgefallen.

Wenn ich Werte in besagter Range per Hand (Tastatur) eintrage wird die Veränderung wie gewollt im Komentar dokumentiert.
Wenn ich jedoch den Wert einer Zelle mit 'Copy(Strg+c) and Past(Strg+v) in eine besagte Zelle einfüge wird der Kommentar zwar eingetragen jedoch die vorhandenen Kommentare ersetzt, also gelöscht.

Wie ändert man das?
 
  NMa.xlsx (Größe: 22,99 KB / Downloads: 9)

Code:

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Dim r As Range
'Für jede geänderte Zelle

If Target.Columns.Count > 13 Or Target.Rows.Count > 39 Then Exit Sub
'Beschränkt die Arbeit fuer Excel auf den angegebenen Bereich
'Ohne letzte Code Zeile brauchte Excel ewig um Zeilen oder Spalten zu erstellen oder zu loeschen

For Each r In Target

'->Fuer die zwei Range Bereiche
If Not Intersect(r, Range("E2:F39,I2:Q39")) Is Nothing Then

'->dann Kommentar eintragen
Call AenderungskennungAlsKommentar(r)

End If
Next
Set r = Nothing
End Sub

'********************************************************

Private Function AenderungskennungAlsKommentar(r As Range)
'*** Aenderung in Zellen wird im Kommentar dokumentiert
'*** Benutzerkennung und Änderungszeitpunkt wird eingetragen
'*** Ist kein Kommentar vorhanden, wird ein neuer angelegt

Dim s As String, s_user As String
'->ggf. vorhandenen Kommentar lesen

On Error Resume Next
s = r.Comment.Text
If Err.Number <> 0 Then
Err.Clear

'->neuen Kommentar anlegen falls keiner vorhanden
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)

'->Datum und Benutzer an Kommentar anfügen
s = s & Format(Now(), "yyyy.mm.dd_hh:nn ") & "Uhr" & s_user

'->Kommentar eintragen
r.Comment.Text s

End Function

Gruß Frank