Zeitmakro plus Zellabfrage

[schauan]

Hallo Peggy,

mein Vorschlag schreibt beim Speichern in D1 ein Datum rein

[Guschti]

Hallo
 
UF = UserForm
 
Alles ohne Formeln im Tabellenblatt, alles ohne Zeitgeber
Eingaben werden via Textbox in der UF
Die Textbox benötigt 13 Zeichen
Das VBA Projekt ist mit Passwort (123) geschützt
Die Vorlage wird nach jeder Eingabe gespeichert
Bei einem neuen Tag, wird zuerst die Vorlage als JJJJ.MM.TT.xlsx kopiert und ins Verzeichnis „C:\Tagesspeicher\“ abgelegt ev. anpassen
Die Vorlage beginnt von neuem.

 Im Modul dieseArbeitsmappe

Code:

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Save
End Sub
Private Sub Workbook_Open()
UserForm1.Show
End Sub
Private Sub Workbook_NewSheet(ByVal Sh As Object)
    Application.ScreenUpdating = False
        Application.DisplayAlerts = False
            Sh.Delete
        Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Im Modul der UserForm

Code:

Option Explicit
Private Sub CommandButton1_Click()
Dim AnzZeichen
AnzZeichen = Len(TextBox1.Value)
    If AnzZeichen <> 13 Then GoTo Meld
    Dim NächstZeil As Integer
    If Range("A3") = "" Then GoTo Weiter
    If Date <> Tabelle2.[A3] Then NeuerTag
Weiter:
        NächstZeil = Range("A800").End(xlUp).Row + 1
            Cells(NächstZeil, 1) = Date
            Cells(NächstZeil, 2) = Time
            Cells(NächstZeil, 3) = UserForm1.TextBox1.Value
                UserForm1.TextBox1.Value = ""
                    UserForm1.TextBox1.SetFocus
    ThisWorkbook.Save
    Exit Sub
Meld:
    MsgBox "Es dürfen nur 13 Zeichen in der Textbox stehen¨"
    UserForm1.TextBox1.SetFocus
End Sub
Private Sub CommandButton2_Click()
    UserForm1.Hide
    ThisWorkbook.Close
End Sub
Private Sub Label2_Click()
    UserForm1.Hide
End Sub
Private Sub userform_QueryClose(Cancel As Integer, CloseMode As Integer)
    'Userform nicht übers Kreuz schliessen
    If CloseMode = 0 Then Cancel = 1
End Sub

Im Modul1

Code:

Option Explicit
Option Private Module
Public Sub UF_Zeigen()
    UserForm1.Show
End Sub
Public Sub NeuerTag()
    Dim Pfad As String, Datei As String
    Pfad = "C:\Tagesspeicher\" 'Pfad anpassen
    Datei = Format(Range("A3"), "YYYY.MM.DD") & ".xlsx"
        Tabelle2.Copy
    Application.DisplayAlerts = False
        ActiveSheet.SaveAs Pfad & Datei
        ActiveWorkbook.Close
    Application.DisplayAlerts = True
        Tabelle2.Range("A3:C800") = ""
End Sub

Mfg Guschti

[Peggymaus]

Hallo,

vielen Dank für Eure Hilfe und auch für die Kommentare.

Habe ja nie behauptet, dass ich ein Profi bin... :19:

Nach ein bißchen tüfteln, habe ich jetzt eine Datei die im Moment funktioniert.

Werde das Ganze morgen mal live auf Arbeit testen und Euch dann berichten.

LG.

Peggy

[Guschti]

Hallo Peggy

Damit du auf den Projektexplorer kommst um den Pfad der Ablagen anzupassen, musst du die UF schliessen.
Und das geht so ...
klicke in der UF in den rotumrandeten Bereich.

Mfg Guschti