Messagebox bei bestimmten Datum

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_Open() Dim wksTab As Worksheet Dim strGeburtstag As String Dim strFS As String Dim strKarte As String For Each wksTab In Worksheets ' Geburtstga in A1 If wksTab.Range("A1") "" Then If Day(wksTab.Range("A1")) = Day(Date) And Month(wksTab.Range("A1")) = Month(Date) _ Then _ strGeburtstag = strGeburtstag & vbLf & wksTab.Name End If ' Führerscheindatum in A2 If wksTab.Range("A2") "" Then If Date + 30 >= wksTab.Range("A2") Then strFS = strFS & vbLf & wksTab.Name End If ' Fahrerkartendatum in A3 If wksTab.Range("A3") "" Then If Date + 30 >= wksTab.Range("A3") Then strKarte = strKarte & vbLf & wksTab.Name End If Next wksTab If strGeburtstag "" Then MsgBox "Heute haben Geburtstag:" & vbLf & strGeburtstag Else MsgBox "Heute hat niemand Geburtstag" End If If strFS "" Then MsgBox "Führerschein abgelaufen:" & vbLf & strFS If strKarte "" Then MsgBox "Fahrerkarte abgelaufen:" & vbLf & strKarte End Sub

Hi,
1. solltest du keine Mappen hochladen, bei denen du ein Application.Quit (und Application.Visible = False) drin hast - zumindest solltest du es auskommentieren, damit man die Mappe nicht nochmal herunterladen und erst ohne aktivierte Makros speichern muss um das anschließend selbst zu machen
2. die Codezeile Start.Show solltest du ans Ende des Workbook_Open-Ereignisses setzen, denn sonst wird der Codeteil zum Zählen der Geburtstage erst ausgeführt, nachdem das UserForm wieder geschlossen wird
3. weiß ich immer noch nicht, an welcher Stelle im Code die Fehlermelsung kommt und nachvollzeihen kann ich es logischerweise nicht, da in der hochgeladenen Mappe kein Fehler auftritt. Ich kann also nur raten: in einer der Tabellen steht in einer der Zellen, die auf ein Datum geprüft werden, ein Text, der bekanntlich nicht als Datum interpretiert werden kann - folglich genannter Laufzeitfehler. Falls das so ist, achte darauf, dass in den allen Tabellen in den geprüften Zellen jeweils ein Datum steht oder ändere den Code dahingehend, dass du prüfst, ob ein Datum drin steht - nach diesem Prinzip: If IsDate(wksTab.Range("A4"))
Eventuell musst du die tabelle "Vorlage" noch aus der Prüfung überhaupt ausschließen - das hängt aber davon ab, ob dort in einer der relevanten 3 Zellen etwas steht.

So!
Ich hab es endlich geschafft, dass das Datum richtig eingefügt wird.
Leider kommt dennoch eine Fehlermeldung (wieder mal XD)
Laufzeitfehler 13
Typen unverträglich!

Option Explicit
Private Sub ButtonAnlegen_Click()
If TextBoxDienstnummer = "" Then
MsgBox "                         Bitte  Dienstnummer  eintragen                      "
Exit Sub
End If
If TextBoxVorname = "" Then
MsgBox "                         Bitte  Vorname  eintragen                      "
Exit Sub
End If
If TextBoxNachname = "" Then
MsgBox "                         Bitte  Nachname  eintragen                      "
Exit Sub
End If
Dim wksTab As Worksheet
Dim blnVorhanden As Boolean
Dim NeuerTabellenName As String
'... Code für die TextBoxen
NeuerTabellenName = Sheets("Vorlage").Range("A1").Value
For Each wksTab In Worksheets
If wksTab.Name = NeuerTabellenName Then
blnVorhanden = True
Exit For
End If
Next wksTab
If blnVorhanden Then
MsgBox NeuerTabellenName & " wurde schon erstellt!  "
Unload Me
Else
ActiveWorkbook.Sheets("Vorlage").Copy _
after:=Worksheets(Worksheets.Count)
Sheets(Sheets.Count).Name = NeuerTabellenName
End If
'... Code für die TextBoxen
TextBoxDienstnummer = ""
TextBoxVorname = ""
TextBoxNachname = ""
TextBoxGeburtsdatum = ""
TextBoxHandynummer = ""
TextBoxFestnetznummer = ""
TextBoxEmailadresse = ""
ComboBoxFreieTage = ""
ComboBoxGruppe = ""
TextBoxFunktion = ""
TextBoxEintritt = ""
TextBoxFührerschein = ""
TextBoxFahrerkarte = ""
TextBoxTransponder = ""
TextBoxKennzeichenMS = ""
TextBoxKennzeichenES = ""
ActiveWorkbook.Sheets("Vorlage").Range("A10") = ""
Call Bilder_löschen
Call Datumformat
Unload MitarbeiterErstellen
End Sub
Private Sub ButtonBildeinfügen_Click()
Call VBAProject.BilderEinfügenErstellen.Test
End Sub
Private Sub ButtonLöschen_Click()
TextBoxDienstnummer = ""
TextBoxVorname = ""
TextBoxNachname = ""
TextBoxGeburtsdatum = ""
TextBoxHandynummer = ""
TextBoxFestnetznummer = ""
TextBoxEmailadresse = ""
ComboBoxFreieTage = ""
ComboBoxGruppe = ""
TextBoxFunktion = ""
TextBoxEintritt = ""
TextBoxFührerschein = ""
TextBoxFahrerkarte = ""
TextBoxTransponder = ""
TextBoxKennzeichenMS = ""
TextBoxKennzeichenES = ""
Sheets("Vorlage").Range("A10") = ""
Unload MitarbeiterErstellen
End Sub
Private Sub ComboBoxFreieTage_Change()
Sheets("Vorlage").Range("A8") = ComboBoxFreieTage
End Sub
Private Sub ComboBoxGruppe_Change()
Select Case ComboBoxGruppe.Value
Case "Gruppe 1 + Linien": ZusatzGruppe2.Show
Case "Gruppe 2 + Linien": ZusatzGruppe1.Show
End Select
Sheets("Vorlage").Range("A9") = ComboBoxGruppe
End Sub
Private Sub TextBoxDienstnummer_Change()
Sheets("Vorlage").Range("A1") = TextBoxDienstnummer
End Sub
Private Sub TextBoxEintritt_Change()
Sheets("Vorlage").Range("A13") = TextBoxEintritt
End Sub
Private Sub TextboxFahrerkarte_Change()
Worksheets(2).Cells(15, 1).Value = CDate(TextBoxFahrerkarte.text)
Worksheets(2).Cells(15, 1).NumberFormat = "DD/MM/YYYY"
End Sub
Private Sub TextBoxFührerschein_Change()
Sheets("Vorlage").Range("A14") = TextBoxFührerschein
End Sub
Private Sub TextBoxFunktion_Change()
Sheets("Vorlage").Range("A11") = TextBoxFunktion
End Sub
Private Sub TextBoxGeburtsdatum_Change()
Sheets("Vorlage").Range("A4") = TextBoxGeburtsdatum
End Sub
Private Sub TextBoxHandynummer_Change()
Sheets("Vorlage").Range("A5") = TextBoxHandynummer
End Sub
Private Sub TextBoxKennzeichenES_Change()
Sheets("Vorlage").Range("A17") = TextBoxKennzeichenES
End Sub
Private Sub TextBoxKennzeichenMS_Change()
Sheets("Vorlage").Range("A16") = TextBoxKennzeichenMS
End Sub
Private Sub TextBoxEmailadresse_Change()
Sheets("Vorlage").Range("A7") = TextBoxEmailadresse
End Sub
Private Sub TextBoxNachname_Change()
Sheets("Vorlage").Range("A3") = TextBoxNachname
End Sub
Private Sub TextBoxFestnetznummer_Change()
Sheets("Vorlage").Range("A6") = TextBoxFestnetznummer
End Sub
Private Sub TextBoxTransponder_Change()
Sheets("Vorlage").Range("A12") = TextBoxTransponder
End Sub
Private Sub TextBoxVorname_Change()
Sheets("Vorlage").Range("A2") = TextBoxVorname
End Sub

Es geht um die TextBoxFahrerkarte!
Sobald ich auf "Erstellen" klicke, tut er eigentlich das, was er tun sollte. Jedoch kommt diese Meldung
Lg

Private Sub TextBoxFahrerkarte_AfterUpdate() If IsDate(TextBoxFahrerkarte.Text) Then Worksheets("Vorlage").Cells(15, 1).Value = CDate(TextBoxFahrerkarte.Text) Worksheets("Vorlage").Cells(15, 1).NumberFormat = "DD/MM/YYYY" Else MsgBox "Bitte ein korrektes Dateum eingeben" End If End Sub

For Each wksTab In Worksheets If wksTab.Name "Vorlage" And wksTab.Name "Info" Then ' Geburtstga in A1 If wksTab.Range("A1") "" Then If Day(wksTab.Range("A1")) = Day(Date) And _ Month(wksTab.Range("A1")) = Month(Date) Then _ strGeburtstag = strGeburtstag & vbLf & wksTab.Name End If ' Führerscheindatum in A2 If wksTab.Range("A2") "" Then If Date + 30 >= wksTab.Range("A2") Then strFS = strFS & vbLf & wksTab.Name End If ' Fahrerkartendatum in A3 If wksTab.Range("A3") "" Then If Date + 30 >= wksTab.Range("A3") Then strKarte = strKarte & vbLf & wksTab. _ Name End If End If Next wksTab

Beliebteste Forumthreads (12 Monate)

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Messagebox bei bestimmten Datum

19 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)

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread