Excel VBA Quelltext von Userform optimieren

[goodies]

Hallo VBA Freunde!

Ich habe mir den Code für ein Userform nach Ewigkeiten mal wieder rausgekramt und wollte die Experten in der Runde fragen ob ihr Optimierungspotential am Quelltext seht.

Am meisten stört mich die Datumsüberprüfung. Macht hier eine eigene ausgelagerte Funktion vielleicht mehr Sinn oder reich es wenn ich die ifs so umschreibe, dass ich ohne goto auskomme. (bzw. ist dieses goto hier gar nicht so schlimm- hab mal gehört dass man dies eigentlich nur bei der Fehlerbehandlung nutzen sollte...)

Wenn ich es richtig verstanden habe, lässt der Quelltext von Userforms nicht durchs errorhandling abfragen, ist dies richtig? Aber integrierte Unter- bzw- Funktionsroutinen in dem Userformcode können dann ja schon wieder per Fehlerabfrage gehandelt werden. Gibt's hier ein "Best Practice" wie Ihr die Fehlerbehandlung in Userformcode behandelt.

Vielen Dank für Eure Ideen und jede Hilfestellung
Liebe Grüße aus dem Allgäu
Ingo

Hier der bisherige Quelltext des Userforms zum anlegen von Datensätzen, welcher funktionell auch sehr gut funktioniert :

Code:

Private Sub cmdEintragen_Click()
' Deklaration der Variablen
    Dim ErsteLeereZeile As Long
    Dim geburtstag As String
    ErsteLeereZeile = wksKontakt.UsedRange.Rows.Count + 1
    geburtstag = Me.txtGeburtstag.Value

    'Geburtstag überprüfen
    'Überprüfen ob Datumstextfeld leer ist
    If geburtstag = "" Then
        GoTo KeinDatumEingegeben
    ElseIf Not IsDate(geburtstag) Then
        MsgBox "Keine richtige Datumseingabe"
        Exit Sub
        ' Datum Kleiner 1.3.1900
    ElseIf CDate(geburtstag) <= CDate("1.3.1900") Then
        MsgBox "Datumswerte erst ab 1.3.1900 möglich"
        Exit Sub
        ' Datum Größer als Heute
    ElseIf CDate(geburtstag) > Date Then
        MsgBox "Datum liegt in der Zukunft! Beam me up Scotty!!!"
        Exit Sub
    Else
    End If
KeinDatumEingegeben:
    'Ende Geburtstagüberprüfung
    ' Werte Eintragen
    wksKontakt.Cells(ErsteLeereZeile, 1).Value = wert
    wksKontakt.Cells(ErsteLeereZeile, 2).Value = Me.txtNachname.Value
    wksKontakt.Cells(ErsteLeereZeile, 3).Value = Me.txtVorname.Value
    wksKontakt.Cells(ErsteLeereZeile, 4).Value = Me.txtStrasse.Value
    wksKontakt.Cells(ErsteLeereZeile, 5).Value = Me.txtPLZ.Value
    wksKontakt.Cells(ErsteLeereZeile, 6).Value = Me.txtOrt.Value
    wksKontakt.Cells(ErsteLeereZeile, 7).Value = Me.txtTelefon.Value
    wksKontakt.Cells(ErsteLeereZeile, 8).Value = Me.txtHandy.Value
    wksKontakt.Cells(ErsteLeereZeile, 9).Value = Me.txtEmail.Value
    wksKontakt.Cells(ErsteLeereZeile, 10).Value = Me.txtWebseite.Value
    wksKontakt.Cells(ErsteLeereZeile, 14).Value = Me.txtFirma.Value
    'Weitere Steuerelemente
    'Comboxeintrag in Spalte Gruppe Eintragen
    wksKontakt.Cells(ErsteLeereZeile, 11).Value = Me.cboGruppe.Value
    ' Kontollkästchen eintragen
    wksKontakt.Cells(ErsteLeereZeile, 12).Value = Me.chkReferenz.Value
    ' Optionsfelder aus Frame eintragen (Geschlechtauswahl)
    Dim geschlecht As String
    Dim Optionsfeld As MSforms.Control
    For Each Optionsfeld In fraGeschlecht.Controls
        If Optionsfeld.Value = True Then
            geschlecht = Optionsfeld.Tag
        End If
    Next Optionsfeld
    ' Optionsfeld eintragen
    wksKontakt.Cells(ErsteLeereZeile, 13).Value = geschlecht
    ' Optionsfelder aus Frame eintragen (Regionsauswahl)
    Dim region As String
    Dim OptionsfeldRegion As MSforms.Control
    For Each OptionsfeldRegion In fraRegion.Controls
        If OptionsfeldRegion.Value = True Then
            region = OptionsfeldRegion.Tag
        End If
    Next OptionsfeldRegion
    ' Optionsfeld eintragen (Regionsauswahl)
    wksKontakt.Cells(ErsteLeereZeile, 15).Value = region
    If geburtstag <> "" Then
        ' Geburtstag
        wksKontakt.Cells(ErsteLeereZeile, 16).Value = CDate(geburtstag)
        ' Altersberechnung anhand des Geburtstags
        wksKontakt.Cells(ErsteLeereZeile, 17).Value = "=DATEDIF([@Geburtsdatum],TODAY(),""y"")"
    Else
        wksKontakt.Cells(ErsteLeereZeile, 17).Value = ""
    End If
    proSortIdAuf
    Unload frmEintrag
End Sub

[Klaus-Dieter]

Hallo,

ohne die Datei kann man da nicht allzu viel machen. Der Quelltext wirkt ein bisschen unstrukturiert. Die DIM-Anweisungen gehören alle an den Anfang. Mit GoTo arbeitet man seit dem C64 eher nicht mehr.

[Der Steuerfuzzi]

Hallo,

ich weiß ja nicht, wieviel 121-Jährige es bei euch gibt, aber die folgenden Zeilen scheinen mir überflüssig zu sein:

Code:

ElseIf CDate(geburtstag) <= CDate("1.3.1900") Then
        MsgBox "Datumswerte erst ab 1.3.1900 möglich"
        Exit Sub
        ' Datum Größer als Heute

GoTos sind idR nicht notwendig. Ich würde die Prüfung so machen:

Code:

'Geburtstag überprüfen
    'Überprüfen ob Datumstextfeld leer ist
    If Not IsDate(geburtstag) Or Not geburtstag = "" Then
        MsgBox "Keine richtige Datumseingabe"
        Exit Sub
    Else
        If CDate(geburtstag) > Date Then
            MsgBox "Datum liegt in der Zukunft! Beam me up Scotty!!!"
            Exit Sub
        Else
    End If
    'Ende Geburtstagüberprüfung

Die Variable wert ist weder definiert, noch wird sie im vorliegenden code gefüllt (vielleicht eine globale Variable).

[snb]

Statt:

Code:

wksKontakt.Cells(ErsteLeereZeile, 1).Value = wert

    wksKontakt.Cells(ErsteLeereZeile, 2).Value = Me.txtNachname.Value

    wksKontakt.Cells(ErsteLeereZeile, 3).Value = Me.txtVorname.Value

    wksKontakt.Cells(ErsteLeereZeile, 4).Value = Me.txtStrasse.Value

    wksKontakt.Cells(ErsteLeereZeile, 5).Value = Me.txtPLZ.Value

    wksKontakt.Cells(ErsteLeereZeile, 6).Value = Me.txtOrt.Value

    wksKontakt.Cells(ErsteLeereZeile, 7).Value = Me.txtTelefon.Value

    wksKontakt.Cells(ErsteLeereZeile, 8).Value = Me.txtHandy.Value

    wksKontakt.Cells(ErsteLeereZeile, 9).Value = Me.txtEmail.Value

    wksKontakt.Cells(ErsteLeereZeile, 10).Value = Me.txtWebseite.Value

    wksKontakt.Cells(ErsteLeereZeile, 14).Value = Me.txtFirma.Value

    'Weitere Steuerelemente

    'Comboxeintrag in Spalte Gruppe Eintragen

    wksKontakt.Cells(ErsteLeereZeile, 11).Value = Me.cboGruppe.Value

    ' Kontollkästchen eintragen

    wksKontakt.Cells(ErsteLeereZeile, 12).Value = Me.chkReferenz.Value

Reicht:

Code:

wksKontakt.Cells(1, 1).resize(,12) = array(wert, txtNachname, txtVorname, txtStrasse, txtPLZ, txtOrt, txtTelefon, txtHandy, txtEmail, txtWebseite, txtFirma, cboGruppe, chkReferenz)

[goodies]

Vielen Dank Ihr Drei, für die super Verbesserungsvorschläge zu meinem Script
...diese werden gleich eingebaut und für weiteren Quelltext beherzigt!
Beste Grüße 
Ingo