AW: UserForm-Eingaben prüfen
01.05.2007 08:08:00
Erich
Hallo Lenhard,
ich hoffe, du hast noch nicht zu viel Zeit in die Integration gesteckt. Da waren noch ein paar Ungereimtheiten drin.
(war ja ungestestet...)
Ich habe eine UF mit drei Boxen nachgebaut und den Code dafür überarbeitet:
Option Explicit
' In den BeforeUpdate-Prozeduren wird sichergestellt, dass die jeweilige Box
' keinen unzulässigen Wert enthält.
' (Es muss nichts eingegeben werden. Wenn etwas eingegeben wird, muss es gültig sein.)
' Bei Datums-Boxen mit gültigem Datum wird das Datum ins Standardformat gebracht.
' (Wenn man z. B. 4-5-6 eingibt, erscheint 04.05.2006)
Private Sub txtBoxDatum_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
With txtBoxDatum
If .Text = "" Then Exit Sub ' "Leer" ist hier erlaubt
If IsDate(.Text) Then
.Text = CDate(.Text) ' Standardformat
Else
MsgBox "Bitte geben Sie ein gültiges Datum ein!", 64, "Fehler"
Cancel = True
End If
End With
End Sub
Private Sub TextBoxNachname_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If Len(TextBoxNachname.Text) = 1 Then
MsgBox "Nachnamen mit nur einem Zeichen sind nicht möglich!", 64, "Fehler"
Cancel = True
End If
End Sub
Private Sub TextBoxGebDat_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
With TextBoxGebDat
If .Text = "" Then Exit Sub
If IsDate(.Text) Then
.Text = CDate(.Text)
Else
MsgBox "Bitte geben Sie ein gültiges Geburtsdatum ein!", 64, "Fehler"
Cancel = True
End If
End With
End Sub
' In der OK-Prozedur wird geprüft, ob alle Muss-Boxen Werte enthalten.
' (WENN ein Wert drinsteht, ist er gültig, wurde geprüft in BeforeUpdate.)
' Beim Geburtsdatum wird zusätzlich geprüft, ob es sich mit dem Datum verträgt.
' (Dann ist schon sicher, dass txtBoxDatum ein gültiges Datum enthält.)
Private Sub CommandButton1_Click() ' OK-Button
Dim lz As Integer
' --------------------------------------------------------------------- Prüfungen
With txtBoxDatum
If .Text = "" Then
MsgBox "Bitte geben Sie ein Datum ein!", 64, "Fehler"
.SetFocus
.Text = Format(Date, "dd.mm.yyyy")
.SelStart = 0
.SelLength = Len(.Text)
Exit Sub
End If
End With
With TextBoxNachname
If .Text = "" Then
MsgBox "Bitte geben Sie einen Nachnamen ein!", 64, "Fehler"
.SetFocus
Exit Sub
End If
End With
With TextBoxGebDat
If .Text = "" Then
MsgBox "Bitte geben Sie ein Geburtsdatum ein!", 64, "Fehler"
.SetFocus
Exit Sub
Else
If CDate(.Text) > CDate(txtBoxDatum) Then
MsgBox "Das Geburtsdatum kann nicht vor dem obigen Datum liegen!", 64, "Fehler"
.SetFocus
Exit Sub
End If
End If
End With
' --------------------------------------------------------------------- Ausgabe
Application.ScreenUpdating = False
With Sheets("Röntgendokumentation")
'Prüft ob eine Zeile kpl. frei ist
lz = .Range("B:O").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1
'Realisiert die fortlaufende Nummerierung in Spalte B
.Cells(lz, 2) = WorksheetFunction.Max(Range(.Cells(5, 1), .Cells(lz, 2))) + 1
'.Unprotect
.Cells(lz, 3) = CDate(txtBoxDatum.Text)
' .Cells(lz, 4) = ComboBoxStation
.Cells(lz, 5) = TextBoxNachname.Text
' .Cells(lz, 6) = TextBoxVorname
.Cells(lz, 7) = CDate(TextBoxGebDat.Text)
' .Cells(lz, 8) = ComboBoxUntersuchung
' .Cells(lz, 9) = ComboBoxArzt
' .Cells(lz, 10) = ComboBoxPflege01
' .Cells(lz, 11) = ComboBoxPflege02
' .Cells(lz, 12) = TextBoxKV
' .Cells(lz, 13) = TextBoxMA
' .Cells(lz, 14) = TextBoxMin
' .Cells(lz, 15) = TextBoxGRay
' .Cells(lz, 16) = TextBoxBilderAnzahl
'.Protect
End With
Unload Me
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton2_Click() ' Abbrechen
Unload Me
End Sub
Und hier meine Mappe - zum Ausprobieren:
https://www.herber.de/bbs/user/42156.xls
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort