Jetzt gibt es doch noch ein Problem in einem neu angelegten form klappte das Super, nur jetzt als ich versuche das in mein Richtiges Form einzubauen bekommen ich aus welchen gründen auch immer einen Fehler 438 OBjekt unterstüzt EIgenschaft oder Methode nicht !
Ich Poste den Code mal hier rein Sorry das der so ewig lang ist bin halt Anfänger:
Private Sub cmdBeenden_Click()
Unload Me
End Sub
Private Sub cmdspeichern_Click()
If Trim(txtname.Text) = "" Then
MsgBox "Kein Benutzername eingetragen!"
txtname.SetFocus
Exit Sub
End If
If Trim(txtbenutznr.Text) = "" Then
MsgBox "Keine BenutzerNr eingetragen!"
txtbenutznr.SetFocus
Exit Sub
End If
If Trim(txtname.Text) = "" Then
MsgBox "Kein Nachname eingetragen"
txtname.SetFocus
Exit Sub
End If
If optbausleihe.Value = optbrueckg.Value Then
MsgBox "Bitte Ausleihe oder Rückgabe wählen !"
Exit Sub
End If
If optbausleihe Then Cells(lngLetzteZeile + 2, 1) = "Ausleihe"
If optbausleihe Then Cells(lngLetzteZeile, 2) = "Ausleihe"
If optbausleihe Then Cells(lngLetzteZeile, 3) = "Ausleihe"
If optbrueckg Then Cells(lngLetzteZeile + 2, 1) = "Rückgabe"
If optbrueckg Then Cells(lngLetzteZeile, 2) = "Rückgabe"
If optbrueckg Then Cells(lngLetzteZeile, 3) = "Rückgabe"
Cells(lngLetzteZeile + 2, 1) = "Benutzername:"
Cells(lngLetzteZeile, 2) = txtname.Text
Cells(lngLetzteZeile + 2, 1) = "BenutzerNr:"
Cells(lngLetzteZeile, 2) = txtbenutznr.Text
Cells(lngLetzteZeile + 2, 1) = "Datum:"
Cells(lngLetzteZeile, 2) = tbdatum.Text
Cells(lngLetzteZeile + 1, 1) = "_________________"
Cells(lngLetzteZeile, 2) = "__________________"
Cells(lngLetzteZeile, 3) = "_______________"
Cells(lngLetzteZeile + 1, 1) = "BuchungsNr:"
Rem Zellen füllen falls leer
Rem-------------------------------------------------------------------------------------
If txt01 = "" Then
txt01 = "-"
End If
If txt02 = "" Then
txt02 = "-"
End If
If txt03 = "" Then
txt03 = "-"
End If
If txt04 = "" Then
txt04 = "-"
End If
If txt05 = "" Then
txt05 = "-"
End If
If txt06 = "" Then
txt06 = "-"
End If
If txt07 = "" Then
txt07 = "-"
End If
If txt08 = "" Then
txt08 = "-"
End If
If txt09 = "" Then
txt09 = "-"
End If
If txt10 = "" Then
txt10 = "-"
End If
Rem -----------------------------------------------------------------------------------------------
Rem Ende
Cells(lngLetzteZeile + 2, 1) = txt01.Text
Cells(lngLetzteZeile, 2) = txt11.Text
Cells(lngLetzteZeile, 3) = txt21.Text
Cells(lngLetzteZeile + 1, 1) = txt02.Text
Cells(lngLetzteZeile, 2) = txt12.Text
Cells(lngLetzteZeile, 3) = txt22.Text
Cells(lngLetzteZeile + 1, 1) = txt03.Text
Cells(lngLetzteZeile, 2) = txt13.Text
Cells(lngLetzteZeile, 3) = txt23.Text
Cells(lngLetzteZeile + 1, 1) = txt04.Text
Cells(lngLetzteZeile, 2) = txt14.Text
Cells(lngLetzteZeile, 3) = txt24.Text
Cells(lngLetzteZeile + 1, 1) = txt05.Text
Cells(lngLetzteZeile, 2) = txt15.Text
Cells(lngLetzteZeile, 3) = txt25.Text
Cells(lngLetzteZeile + 1, 1) = txt06.Text
Cells(lngLetzteZeile, 2) = txt16.Text
Cells(lngLetzteZeile, 3) = txt26.Text
Cells(lngLetzteZeile + 1, 1) = txt07.Text
Cells(lngLetzteZeile, 2) = txt17.Text
Cells(lngLetzteZeile, 3) = txt27.Text
Cells(lngLetzteZeile + 1, 1) = txt08.Text
Cells(lngLetzteZeile, 2) = txt18.Text
Cells(lngLetzteZeile, 3) = txt28.Text
Cells(lngLetzteZeile + 1, 1) = txt09.Text
Cells(lngLetzteZeile, 2) = txt19.Text
Cells(lngLetzteZeile, 3) = txt29.Text
Cells(lngLetzteZeile + 1, 1) = txt10.Text
Cells(lngLetzteZeile, 2) = txt20.Text
Cells(lngLetzteZeile, 3) = txt30.Text
'Cells(lngLetzteZeile + 1, 1) = "###"
'Cells(lngLetzteZeile, 2) = "###"
'Cells(lngLetzteZeile, 3) = "###"
If optbausleihe Then Cells(lngLetzteZeile + 1, 1) = "Ausleihe Ende"
If optbausleihe Then Cells(lngLetzteZeile, 2) = "Ausleihe Ende"
If optbausleihe Then Cells(lngLetzteZeile, 3) = "Ausleihe Ende"
If optbrueckg Then Cells(lngLetzteZeile + 1, 1) = "Rückgabe Ende"
If optbrueckg Then Cells(lngLetzteZeile, 2) = "Rückgabe Ende"
If optbrueckg Then Cells(lngLetzteZeile, 3) = "Rückgabe Ende"
ActiveWorkbook.Save
End Sub
Rem Felder Löschen
Rem ---------------------------------------------------------------------------------------------------
Private Sub Löschen_Click()
optbausleihe = False
optbrueckg = False
txtname.Text = " "
txtbenutznr.Text = " "
txt01.Text = " "
txt11.Text = " "
txt21.Text = " "
txt02.Text = " "
txt12.Text = " "
txt22.Text = " "
txt03.Text = " "
txt13.Text = " "
txt23.Text = " "
txt04.Text = " "
txt14.Text = " "
txt24.Text = " "
txt05.Text = " "
txt15.Text = " "
txt25.Text = " "
txt06.Text = " "
txt16.Text = " "
txt26.Text = " "
txt07.Text = " "
txt17.Text = " "
txt27.Text = " "
txt08.Text = " "
txt18.Text = " "
txt28.Text = " "
txt09.Text = " "
txt19.Text = " "
txt29.Text = " "
txt10.Text = " "
txt20.Text = " "
txt30.Text = " "
End Sub
Rem Felder Löschen ende
Rem ----------------------------------------------------------------------------------------
Private Sub txt11_Change()
End Sub
'### Aktuelles Datum wird in tbdatum angezeigt ###
Private Sub UserForm_Initialize()
tbdatum.Value = Date
End Sub
'### Aktuelles Datum wird angezeigt ende ###
'############# Form kann nicht über X geschlossen werden ######################
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
MsgBox "Bitte mit dem Button 'Beenden' schließen!"
Cancel = True
End If
End Sub
'###############Form kann nicht über X geschlossen werden Ende #################
' #####Prüfung auf doppelte Eingabe Tb 1- 50 ####
Private Sub txt01_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim ctrl As Control, vnt As Variant
For Each ctrl In Me.Controls
If TypeOf ctrl Is MSForms.TextBox Then
If Not ctrl Is ActiveControl Then
vnt = Trim(ctrl.Value)
If vnt <> "" Then
If vnt = ActiveControl.Value Then
MsgBox "Eingabe schon vorhanden"
ActiveControl.Value = ""
Cancel = True
Exit For
End If
End If
End If
End If
Next ctrl
End Sub
Private Sub txt02_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim ctrl As Control, vnt As Variant
For Each ctrl In Me.Controls
If TypeOf ctrl Is MSForms.TextBox Then
If Not ctrl Is ActiveControl Then
vnt = Trim(ctrl.Value)
If vnt <> "" Then
If vnt = ActiveControl.Value Then <<<< Hier zeigt es dann den Fehler an 438 an
MsgBox "Eingabe schon vorhanden"
ActiveControl.Value = ""
Cancel = True
Exit For
End If
End If
End If
End If
Next ctrl
End Sub
Falls es mehr helfen würde könnte ich auch das Excel File Posten
Danke in Voraus schonmal
|