User dokumentieren

Forumthread: User dokumentieren

User dokumentieren

Petra

Hallo Cracks,
habe folgenden Code in DieseArbeitsmappe:


Private Sub Workbook_Open()
Worksheets("Main Menu").ScrollArea = "A$1:$A$25"
Worksheets("Main Menu").Activate
UserForm1.Show 0
Call Menü_einfügen
Dim iRow As Integer
With Worksheets("Remarks")
iRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(iRow, 1).Value = Application.UserName
.Cells(iRow, 2).Value = Now
.Columns.AutoFit
End With
ThisWorkbook.Save
BlinkenEin
End Sub

Laeuft alles gut. Die Dokumentation des Users soll nach einer Woch immer geloescht werden
Wie bekomme ich das hin?
Danke
Gruss
Petra

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: User dokumentieren / Teilvorschlag

Uwe

Hallo, Petra!
Soll die gesamte Dokumentation (alle verzeichneten User) nach einer Woche gelöscht werden oder nur die Einträge die älter als eine Woche alt sind?
Vermutlich nutzen mehrere Anwender diese Mappe, so dass die komplettlöschung wohl nicht Dein Ziel ist, die Du in der Art hinbekommen würdest:

  With Worksheets("Remarks")
If .Cells(1, 2) < Now - 7 Then .Columns("A:B").ClearContents
iRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
...

Wenn nun also jeweils nur der Bereich gelöscht werden soll, der auf eine Zeit länger als vor sieben Tagen verweist, dann ist die Spalte B bis zur Zeile zu durchsuchen, der eine Zeit beinhaltet, die größer als
.Cells(1, 2) > Now - 7
ist (do..loop until). Nun kann der darüber sich befindende Bereich gelöscht werden und die Zeilen nach oben geschoben werden (ggf. Code über Makro-Aufzeichnung ermitteln).
Hier ist vorausgesetzt, dass der erste gültige Eintrag immer in der Zeile 2 steht.
Vielleicht führt diese Skizze zur Lösung.
Gruß!

AW: User dokumentieren / Teilvorschlag

08.04.2004 09:02:06

Nepumuk

Hallo Petra,
versuch es mal so:

Private Sub Workbook_Open()
    Dim iRow As Integer
    Worksheets("Main Menu").ScrollArea = "A$1:$A$25"
    Worksheets("Main Menu").Activate
    UserForm1.Show 0
    Call Menü_einfügen
    With Worksheets("Remarks")
        For iRow = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            If DateDiff("D", .Cells(iRow, 2).Value, Now) >= 7 Then Exit For
        Next
        .Cells(iRow, 1).Value = Application.UserName
        .Cells(iRow, 2).Value = Now
        .Columns.AutoFit
        .Range("A2:B65536").Sort Key1:=.Cells(2, 2)
    End With
    ThisWorkbook.Save
    BlinkenEin
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Forumthread: User dokumentieren

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread