Office: TextBox mit Datum und Fehlermeldung ... V2.0

Hallo zusammen,

ich habe, nachdem ich mit meiner Version aus dem vorherigen Beitrag nicht mehr weitergekommen bin, versucht die Datumseingabe über ein Dropdownmenü zu regeln.

Jetzt ergibt sich aber folgendes Problem:
Ich möchte beide Datumsangaben auf Vergangenheit prüfen ... das funktioniert.
Dann möchte ich prüfen, ob das Datum plausibel ist (Erledigt darf nicht vor Beginn liegen).
Das funktioniert auch ... aber nur einmal.
Ich kann das Datum ändern, es wird in der Tabelle dann auch richtig angezeigt.
Wenn ich es aber nochmal ändern möchte, wird das Ergebnis nicht mehr ins Tabellenblatt übertragen.

Und wenn ich schon dabei bin ... habt ihr nen Tipp, wie man das Dropdownmenü in "UserForm_Initialize" einfacher gestalten kann? Mit einer Schleife habe ich es nicht hinbekommen, deswegen ist alles einzeln eingetragen.

Ich entschuldige mich jetzt schonmal für den nun folgenden ewig langen Code.

Private Sub UserForm_Initialize()
'Datum Umsetzung bis ...
'Tag
With BoxTag_U1_1
.AddItem "01"
.AddItem "02"
.AddItem "03"
.AddItem "04"
.AddItem "05"
.AddItem "06"
.AddItem "07"
.AddItem "08"
.AddItem "09"
.AddItem "10"
.AddItem "11"
.AddItem "12"
.AddItem "13"
.AddItem "14"
.AddItem "15"
.AddItem "16"
.AddItem "17"
.AddItem "18"
.AddItem "19"
.AddItem "20"
.AddItem "21"
.AddItem "22"
.AddItem "23"
.AddItem "24"
.AddItem "25"
.AddItem "26"
.AddItem "27"
.AddItem "28"
.AddItem "29"
.AddItem "30"
.AddItem "31"
End With

'Monat
With BoxMonat_U1_1
.AddItem "01"
.AddItem "02"
.AddItem "03"
.AddItem "04"
.AddItem "05"
.AddItem "06"
.AddItem "07"
.AddItem "08"
.AddItem "09"
.AddItem "10"
.AddItem "11"
.AddItem "12"
End With

'Jahr
With BoxJahr_U1_1
.AddItem "2023"
.AddItem "2024"
.AddItem "2025"
.AddItem "2026"
.AddItem "2027"
.AddItem "2028"
.AddItem "2029"
.AddItem "2030"
.AddItem "2031"
.AddItem "2032"
.AddItem "2033"
.AddItem "2034"
.AddItem "2035"
.AddItem "2036"
.AddItem "2037"
.AddItem "2028"
.AddItem "2039"
.AddItem "2040"
.AddItem "2041"
.AddItem "2042"
End With


'Datum Erledigt am ...
'Tag
With BoxTag_E1_1
.AddItem "01"
.AddItem "02"
.AddItem "03"
.AddItem "04"
.AddItem "05"
.AddItem "06"
.AddItem "07"
.AddItem "08"
.AddItem "09"
.AddItem "10"
.AddItem "11"
.AddItem "12"
.AddItem "13"
.AddItem "14"
.AddItem "15"
.AddItem "16"
.AddItem "17"
.AddItem "18"
.AddItem "19"
.AddItem "20"
.AddItem "21"
.AddItem "22"
.AddItem "23"
.AddItem "24"
.AddItem "25"
.AddItem "26"
.AddItem "27"
.AddItem "28"
.AddItem "29"
.AddItem "30"
.AddItem "31"
End With

'Monat
With BoxMonat_E1_1
.AddItem "01"
.AddItem "02"
.AddItem "03"
.AddItem "04"
.AddItem "05"
.AddItem "06"
.AddItem "07"
.AddItem "08"
.AddItem "09"
.AddItem "10"
.AddItem "11"
.AddItem "12"
End With

'Jahr
With BoxJahr_E1_1
.AddItem "2023"
.AddItem "2024"
.AddItem "2025"
.AddItem "2026"
.AddItem "2027"
.AddItem "2028"
.AddItem "2029"
.AddItem "2030"
.AddItem "2031"
.AddItem "2032"
.AddItem "2033"
.AddItem "2034"
.AddItem "2035"
.AddItem "2036"
.AddItem "2037"
.AddItem "2028"
.AddItem "2039"
.AddItem "2040"
.AddItem "2041"
.AddItem "2042"
End With
End Sub

Private Sub Button_RevOK1_1_Click()
'Datum Umsetzen bis ... eintragen
Worksheets("Maßnahmenverfolgung").Activate
If Range("C9") = "" Then
Range("C9").Value = BoxTag_U1_1 & "." & BoxMonat_U1_1 & "." & BoxJahr_U1_1
End If
If Range("C9") < CDate(Now) Then
MsgBox "Datum liegt in der Vergangenheit!"
End If
If Range("C9") < CDate(Now) Then
Range("C9") = ""
End If

'Datum Erledigt am ... eintragen
Worksheets("Maßnahmenverfolgung").Activate
If Range("D9") = "" Then
Range("D9").Value = BoxTag_E1_1 & "." & BoxMonat_E1_1 & "." & BoxJahr_E1_1
End If
If Range("D9") < CDate(Now) Then
MsgBox "Datum liegt in der Vergangenheit!"
End If
If Range("D9") < CDate(Now) Then
Range("D9") = ""
End If

'Prüfung ob Datum plausibel
If Range("C9") > Range("D9") Then
MsgBox "Datum nicht plausibel!"
Range("C9,D9") = ""
End If
End Sub

Private Sub Button_RevLöschen1_1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'Datum Umsetzen bis ... löschen
BoxTag_U1_1 = ""
BoxMonat_U1_1 = ""
BoxJahr_U1_1 = ""
Range("C9") = ""

'Datum Erledigt am ... löschen
BoxTag_E1_1 = ""
BoxMonat_E1_1 = ""
BoxJahr_E1_1 = ""
Range("D9") = ""

End Sub


Sorry nochmal und trotzdem schönes Wochenende.
Honk

 

Hallo Honk,

Die meisten bauen Deine Datei nicht nach. Die Zeit hat schon jemand investiert.

Ein Nachbau sieht meist anders aus als das Original. <B>Darum sollte das Original verlinkt werden.</b>
Die meisten möchten es am Original testen um den gleichen Fehler zu erhalten.

Der Name einer hochgeladenen Mappe wird im Beitrag automatisch angezeigt, sodass es bei Verwendung von aussagekräftigen Namen leichter fällt, sie später im Ablageordner wiederzufinden und sie gedanklich einem bestimmten Thema zuzuordnen. Namen wie Muster*, Test*, Mappe*, Beispiel*, Fehler*, Kalender*, UserForm* , Forum* usw. sind so allgemein, dass eine Zuordnung zu einem Thema unmöglich gemacht wird.
Es sollte ein aussagekräftiger Name sein.

Wenn du an Stelle einer Demomappe deine Originalmappe hochladen willst, diese aber sensible Daten enthält, kannst du diese Daten ändern. Schaue Datei
http://hajo-excel.de/gepackt/fremd/Datei_verschluesseln.zip

Ich führe keine Liste unrter welchem Namen die Datei gespoeichert ist.
Der Dateiname steht ja im Beitrag.

Das ist nur meine Meinung zu dem Thema.

Benutze hier im Forum die Funktion zum hochladen. Falls Du die nicht benutzen möchtest, beachte, von unsicheren Servern wie z.B. www.file-upload.net lade ich keine Datei runter. (lt. Einschätzung meines Virenprogramms)

 

Hallo,

was ist an diesen Schleifen so kompliziert, dass es Schwierigkeiten machen könnte?

Code:

Private Sub UserForm_Initialize()
   Dim I As Long
   'Datum Umsetzung bis ...
   'Tag
   With BoxTag_U1_1
      For I = 1 To 31
        .AddItem Format(I, "00")
      Next I
   End With
  
   'Monat
   With BoxMonat_U1_1
      For I = 1 To 12
        .AddItem Format(I, "00")
      Next I
   End With
  
   'Jahr
   With BoxJahr_U1_1
     For I = 2023 To 2042
       .AddItem Format(I, "0000")
     Next I
   End With
  
  
   'Datum Erledigt am ...
   'Tag
   With BoxTag_E1_1
     For I = 1 To 31
       .AddItem Format(I, "00")
     Next I
   End With
  
   'Monat
   With BoxMonat_E1_1
     For I = 1 To 12
       .AddItem Format(I, "00")
     Next I
   End With
  
   'Jahr
   With BoxJahr_E1_1
     For I = 2023 To 2042
       .AddItem Format(I, "0000")
     Next I
   End With
End Sub

 

Moin und ergänzend!
Statt der AddItem-Methode (die bei vielen Einträgen spürbar langsam sein kann) bietet es sich an, die ComboBox "auf einen Rutsch" gleich per .List zu füllen.
Die Jahresauflistung 2023 bis 2042 kann man (mit einem aktuellen Excel) so erzeugen:

Code:

ComboBox1.List = WorksheetFunction.Sequence(20, , 2023)

Für ältere Versionen lohnt sich ein Blick auf diese Seite:
VBA for smarties How to fill a Combobox / Listbox
Dann ist es ein "einfaches"

Code:

ComboBox1.List = Evaluate("row(2023:2042)")

Gruß Ralf

 

Noch etwas!
Ich habe gerade mit unserem Betriebsarzt gesprochen.
Er ist wie ich der Meinung, dass ein Userform, in dem man nacheinander Tag, Monat, Jahr per Maus auswählen soll, hochgradig gesundheitsgefährdend ist!

Falls ich jemals wieder ein Userform programmieren würde, nähme ich einfach eine einzige Textbox für ein Datum.
Dort trage ich mittels Ziffernblock 22-4 ein (es geht auch 22/4 oder 22.4)
Falls das Jahr nicht das aktuelle ist, muss es angehängt werden (22/4/24).
Im _Exit überprüfe ich die Eingabe und wandele sie in ein "gewohntes" Format um:

Code:

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(TextBox1) Then
  TextBox1 = CDate(TextBox1)
Else
  MsgBox TextBox1 & " ist kein gültiges Datum! Let's try it again!"
  TextBox1 = vbNullString
  Cancel = True
End If
End Sub