Clever-Excel-Forum › Office-Anwendungen › Excel v
[VBA] über Userform Formular füllen - Fehler beim Eintragen

Thema geschlossen 
Baumstrukturmodus
[VBA] über Userform Formular füllen - Fehler beim Eintragen
Rabe Offline
:-)
Registriert seit: 10.04.2014
Version(en): 2016 + 365
#1
17.02.2016, 10:03 (Dieser Beitrag wurde zuletzt bearbeitet: 17.02.2016, 10:11 von Rabe.)
Hallo,

ich fülle über eine Userform
   

ein Formular.
Leider werden manche Werte gar nicht oder an falscher Stelle eingefügt.
   

Was ist falsch?

Hier das Makro (Aktivierreihenfolge beachten!):
Option Explicit

Private Sub UserForm_Initialize()
  Dim objWs As Worksheet
  Dim objZeile As Range
  Set objWs = ThisWorkbook.Worksheets("Kundendaten")
  
  For Each objZeile In objWs.UsedRange.Rows
     If objZeile.Row > 1 Then
     Me.ListBox1.AddItem objZeile.Cells(1, 2)
     End If
  Next objZeile
  Set objWs = Nothing
  Set objZeile = Nothing
'   strDatei = ThisWorkbook.Path & "\Logo.jpg" 
'   If Dir(strDatei) = "" Then               ' prüfen, ob Bild vorhanden 
'   MsgBox ("Firmenlogo fehlt! " & Chr(10) & Chr(13) & strDatei) 
'Else 
'   Me.Image1.Picture = LoadPicture(strDatei) 
'   End If 
  
  Set objWs = ThisWorkbook.Worksheets("RechnungsVorlage")
  
  With objWs                                           ' Worksheets("RechnungsVorlage") 
     .Range("K23").ClearContents                       ' Rechnungsnummer 
     .Range("K22").ClearContents                       ' Kundennummer 
     '.Range("F16").ClearContents                       ' eMail-Adresse 
     For i = 16 To 21                                  'Kundendaten 
        .Range("C" & i).ClearContents
     Next i
     
     .Range("K21").ClearContents                       ' Rechnungsdatum 
     .Range("D30").ClearContents                       ' Bezeichnung 1-1 
     .Range("F30").ClearContents                       ' Bezeichnung 1-2 
     .Range("G30").ClearContents                       ' Anzahl 1 
     .Range("H30:I30").ClearContents                       ' Preis 1 
     .Range("D32").ClearContents                       ' Projekttext 1-1 
     .Range("D33").ClearContents                       ' Projekttext 1-2 
     .Range("D34").ClearContents                       ' Projekttext 1-3 
     .Range("D36").ClearContents                       ' Bezeichnung 2-1 
     .Range("F36").ClearContents                       ' Bezeichnung 2-2 
     .Range("G36").ClearContents                       ' Anzahl 2 
     .Range("H36:I36").ClearContents                       ' Preis 2 
     .Range("D38").ClearContents                       ' Projekttext 2-1 
     .Range("D39").ClearContents                       ' Projekttext 2-2 
     .Range("D40").ClearContents                       ' Projekttext 2-3 
     .Range("D42").ClearContents                       ' Bezeichnung 3-1 
     .Range("F42").ClearContents                       ' Bezeichnung 3-2 
     .Range("G42").ClearContents                       ' Anzahl 3 
     .Range("H42:I42").ClearContents                       ' Preis 3 
     .Range("D44").ClearContents                       ' Projekttext 3-1 
     .Range("D45").ClearContents                       ' Projekttext 3-2 
     .Range("D46").ClearContents                       ' Projekttext 3-3 
  End With
'      dteReDatum = vbNullString 
     strBezeichnung1_1 = vbNullString
     strBezeichnung1_2 = vbNullString
     strAnzahl_1 = vbNullString
     strPreis_1 = vbNullString
     strProjekttext1_1 = vbNullString
     strProjekttext1_2 = vbNullString
     strProjekttext1_3 = vbNullString
     strBezeichnung2_1 = vbNullString
     strBezeichnung2_2 = vbNullString
     strAnzahl_2 = vbNullString
     strPreis_2 = vbNullString
     strProjekttext2_1 = vbNullString
     strProjekttext2_2 = vbNullString
     strProjekttext2_3 = vbNullString
     strBezeichnung3_1 = vbNullString
     strBezeichnung3_2 = vbNullString
     strAnzahl_3 = vbNullString
     strPreis_3 = vbNullString
     strProjekttext3_1 = vbNullString
     strProjekttext3_2 = vbNullString
     strProjekttext3_3 = vbNullString
End Sub

Private Sub Userform_Activate()             'Userform aufrufen 
  For i = 1 To 22
     Me.Controls("TextBox" & i) = ""
  Next
  For i = 1 To 3
     Me.Controls("Textbox" & i) = "bitte eintragen"
  Next
  Me.Controls("Textbox16") = VBA.Date
  ListBox1.SetFocus
End Sub

Private Sub CancelButton_Click()           ' Eingabe abbrechen 
  For i = 1 To 22
     Me.Controls("TextBox" & i) = ""
  Next
  boAbbruch = True
  
  Unload Me
  '   Me.Hide 
End Sub

Private Sub ListBox1_Click()
  TextBox1.SetFocus
End Sub

Private Sub okButton1_Click()          ' Übernehmen 
  For i = 1 To 5
     If Me.Controls("TextBox" & i).Value = "" Then Exit Sub
  Next
  
  boAbbruch = False
  
  Application.ScreenUpdating = False
  '   Zelleninhalt_sichern = ActiveCell.Value 
  
  'Datenzeile aus Formular ermitteln 
  lngAdressZeile = ListBox1.ListIndex + 2
  
  'Kundendaten auslesen 
  Set objWs = ThisWorkbook.Worksheets("Kundendaten")
  
  'KdNr    Name    Firma   Strasse Ort Land    PLZ eMail   MWSt 
  strKdNr = objWs.Cells(lngAdressZeile, 1).Value
  strAnsprechpartner = objWs.Cells(lngAdressZeile, 2).Value
  strFirma = objWs.Cells(lngAdressZeile, 3).Value
  strStrasse = objWs.Cells(lngAdressZeile, 4).Value
  strOrt = objWs.Cells(lngAdressZeile, 5).Value
  strLand = objWs.Cells(lngAdressZeile, 6).Value
  strPLZ = objWs.Cells(lngAdressZeile, 7).Value
  streMail = objWs.Cells(lngAdressZeile, 8).Value
  strMWSt = objWs.Cells(lngAdressZeile, 9).Value
  
  ' Kundendaten in Tabelle "RechnungsVorlage" eintragen 
  Set objWs = ThisWorkbook.Worksheets("RechnungsVorlage")
  With Worksheets("Datenbankliste")
     loLetzte = .Cells(Rows.Count, 1).End(xlUp).Row                     ' letzte belegte in Spalte A (1) 
     strReNr = WorksheetFunction.Max(.Range("H2:H" & loLetzte)) + 1
  End With
  
  With objWs                                                 ' Worksheets("RechnungsVorlage") 
     .Range("K23") = strReNr                                 ' Rechnungsnummer 
     .Range("K22") = strKdNr                                 ' Kundennummer 
     .Range("C16") = strAnsprechpartner                      ' Ansprechpartner 
     '.Range("F16") = streMail                                ' eMail-Adresse 
     .Range("C17") = strFirma                                ' Firma 
     .Range("C18") = strStrasse                              ' Straße 
     .Range("C19") = strOrt                                  ' Ort 
     .Range("C20") = strLand                                 ' Land 
     .Range("C21") = strPLZ                                  ' PLZ 
     
     .Range("K21") = dteReDatum                              ' Rechnungsdatum 
     .Range("D30") = strBezeichnung1_1                       ' Bezeichnung 1-1 
     .Range("F30") = strBezeichnung1_2                       ' Bezeichnung 1-2 
     .Range("G30") = strAnzahl_1                             ' Anzahl 1 
     .Range("H30") = strPreis_1                              ' Preis 1 
     .Range("D32") = strProjekttext1_1                       ' Projekttext 1-1 
     .Range("D33") = strProjekttext1_2                       ' Projekttext 1-2 
     .Range("D34") = strProjekttext1_3                       ' Projekttext 1-3 
     .Range("D36") = strBezeichnung2_1                       ' Bezeichnung 2-1 
     .Range("F36") = strBezeichnung2_2                       ' Bezeichnung 2-2 
     .Range("G36") = strAnzahl_2                             ' Anzahl 2 
     .Range("H36") = strPreis_2                              ' Preis 2 
     .Range("D38") = strProjekttext2_1                       ' Projekttext 2-1 
     .Range("D39") = strProjekttext2_2                       ' Projekttext 2-2 
     .Range("D40") = strProjekttext2_3                       ' Projekttext 2-3 
     .Range("D42") = strBezeichnung3_1                       ' Bezeichnung 3-1 
     .Range("F42") = strBezeichnung3_2                       ' Bezeichnung 3-2 
     .Range("G42") = strAnzahl_3                             ' Anzahl 3 
     .Range("H42") = strPreis_3                              ' Preis 3 
     .Range("D44") = strProjekttext3_1                       ' Projekttext 3-1 
     .Range("D45") = strProjekttext3_2                       ' Projekttext 3-2 
     .Range("D46") = strProjekttext3_3                       ' Projekttext 3-3 
     
  End With
  
  '   ActiveCell.Value = Zelleninhalt_sichern 
  Application.ScreenUpdating = True
  '   Unload Me 
  Me.Hide
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Bezeichnung 1-1: Text und Zahl 
  If TextBox1.Value = "" Then Exit Sub
  strBezeichnung1_1 = TextBox1.Value
  '   TextBox2.SetFocus 
End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Bezeichnung 1-2: Text und Zahl 
  If TextBox2.Value = "" Then Exit Sub
  strBezeichnung1_2 = TextBox2.Value
End Sub

Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Projekttext 1-1: Text und Zahl 
  If TextBox3.Value = "" Then Exit Sub
  strProjekttext1_1 = TextBox3.Value
  '   TextBox17.SetFocus 
End Sub

Private Sub TextBox17_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Projekttext 1-2: Text und Zahl 
  strProjekttext1_2 = TextBox17.Value
  '   TextBox18.SetFocus 
End Sub

Private Sub TextBox18_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Projekttext 1-3: Text und Zahl 
  strProjekttext1_3 = TextBox18.Value
  '   TextBox6.SetFocus 
End Sub

Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Anzahl 1: nur Zahl 
  If TextBox4.Value = "" Then Exit Sub
  If IsNumeric(TextBox4.Value) = False Then
  frmFehler.Show
  TextBox4.Value = ""
  TextBox4.SetFocus
  Cancel = True
  Exit Sub
Else
  strAnzahl_1 = TextBox4.Value
  End If
  '   TextBox5.SetFocus 
End Sub

Private Sub TextBox5_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Preis 1: nur Zahl 
  If TextBox5.Value = "" Then Exit Sub
  If IsNumeric(TextBox5.Value) = False Then
  frmFehler.Show
  TextBox5.Value = ""
  TextBox5.SetFocus
  Cancel = True
  Exit Sub
Else
  strPreis_1 = TextBox5.Value
  End If
  '   TextBox6.SetFocus 
End Sub

Private Sub TextBox6_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Bezeichnung 2-1: Text und Zahl 
  strBezeichnung2_1 = TextBox6.Value
  '   TextBox7.SetFocus 
End Sub

Private Sub TextBox7_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Bezeichnung 2-2: Text und Zahl 
  strBezeichnung2_2 = TextBox7.Value
  '   TextBox8.SetFocus 
End Sub

Private Sub TextBox8_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Projekttext 2-1: Text und Zahl 
  strProjekttext2_1 = TextBox8.Value
  '   TextBox19.SetFocus 
End Sub

Private Sub TextBox19_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Projekttext 2-2: Text und Zahl 
  strProjekttext2_2 = TextBox19.Value
  '   TextBox20.SetFocus 
End Sub

Private Sub TextBox20_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Projekttext 2-3: Text und Zahl 
  strProjekttext2_3 = TextBox20.Value
  '   TextBox9.SetFocus 
End Sub

Private Sub TextBox9_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Anzahl 2: nur Zahl 
  If IsNumeric(TextBox9.Value) = False Then
  frmFehler.Show
  TextBox9.Value = ""
  TextBox9.SetFocus
  Cancel = True
  Exit Sub
Else
  strAnzahl_2 = TextBox9.Value
  End If
  '   TextBox10.SetFocus 
End Sub

Private Sub TextBox10_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Preis 2: nur Zahl 
  If IsNumeric(TextBox10.Value) = False Then
  frmFehler.Show
  TextBox10.Value = ""
  TextBox10.SetFocus
  Cancel = True
  Exit Sub
Else
  strPreis_2 = TextBox10.Value
  End If
  '   TextBox11.SetFocus 
End Sub

Private Sub TextBox11_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Bezeichnung 3-1: Text und Zahl 
  strBezeichnung3_1 = TextBox11.Value
  '   TextBox12.SetFocus 
End Sub

Private Sub TextBox12_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Bezeichnung 3-2: Text und Zahl 
  strBezeichnung3_2 = TextBox12.Value
  '   TextBox13.SetFocus 
End Sub

Private Sub TextBox13_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Projekttext 3-3: Text und Zahl 
  strProjekttext3_3 = TextBox13.Value
  '   TextBox21.SetFocus 
End Sub

Private Sub TextBox21_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Projekttext 3-2: Text und Zahl 
  strProjekttext3_2 = TextBox21.Value
  '   TextBox22.SetFocus 
End Sub

Private Sub TextBox22_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Projekttext 3-3: Text und Zahl 
  strProjekttext3_3 = TextBox22.Value
  '   TextBox14.SetFocus 
End Sub

Private Sub TextBox14_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Anzahl 3: nur Zahl 
  strAnzahl_3 = TextBox14.Value
  '   TextBox15.SetFocus 
End Sub

Private Sub TextBox15_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Preis 3: nur Zahl 
  strPreis_3 = TextBox15.Value
  '   TextBox16.SetFocus 
End Sub

Private Sub TextBox16_Enter()                                                               ' Datum 
  '   TextBox16.Value = Date 
End Sub
Private Sub TextBox16_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Datum: nur Datum 
  If TextBox16.Value = "" Then Exit Sub
  If IsDate(TextBox16.Value) = False Then
  frmFehler.Show
  TextBox16.Value = ""
  TextBox16.SetFocus
  Cancel = True
  Exit Sub
Else
  dteReDatum = TextBox16.Value
  End If
End Sub

und hier die Muster-Datei:

.xlsb   2016 Rechnungen - Rabe - Muster.xlsb (Größe: 76,84 KB / Downloads: 10)
Suchen
Top
snb Offline
Benutzer
Registriert seit: 29.09.2015
Version(en): 2030,5
#2
17.02.2016, 10:47
Fang an die Code zu 'entlarven'

z.B.

.Range("K21:K23,F16,C16:C21,...,..").ClearContents
Homepage Suchen
Top
atilla Abwesend
....
Registriert seit: 14.04.2014
Version(en): 2003, 2007
#3
17.02.2016, 12:04
Hallo Ralf,

von mir auch eine Anmerkung.

Das Ganze ist doppelt gemoppelt.
Warum liest Du Zellinhalte erst in Variablen ein, um sie dann wieder in Zellen zu schreiben.
Es dauert ja eine Ewigkeit, bis Daten in die Zellen geschrieben werden.
Also die ganzen Variablen zum Aufnehmen von Zellinhalten löschen.
Gruß Atilla
Suchen
Top
atilla Abwesend
....
Registriert seit: 14.04.2014
Version(en): 2003, 2007
#4
17.02.2016, 12:09
Noch eins,

was snb vorschlägt ist richtig. ich arbeite bei solchen Projekten viel mit benannten Namen.

Ich hätte für diesen Fall alle Zellen, die auf einen Schlag geleert werden müssen in der Tabelle mit gedrückter Strg Taste markiert und diesen den Namen "Eingabebereich"
gegeben.

Im Code reicht dann:
Range("Eingabebereich").Clearcontents

Das Formular hätte ich so aufgebaut, das die Eingabezellen nicht durch leer Zellen unterbrochen werden. Also alles als zusammenhängenden Bereich.
dann kann man auch diesen als zusammenhängenden Bereich in einem hin und her schreiben.
Gruß Atilla
Suchen
Top
Rabe Offline
:-)
ThreadStarter
Registriert seit: 10.04.2014
Version(en): 2016 + 365
#5
17.02.2016, 13:24 (Dieser Beitrag wurde zuletzt bearbeitet: 17.02.2016, 14:07 von Rabe.)
Hallo,

so, ich habe es jetzt mal radikal zusammengefasst und die Variablen rausgeschmissen. Benannte Bereiche wurden aber noch nicht verwendet. Die Vorlage und damit die Leerzeilen sind vorgegeben, ich denke, aus optischen Zwecken sind die Leerzeilen und -Spalten drin. Aber das mit Schreiben in einem Rutsch interessiert mich auch, aber mit Array ist mir das zu hoch. Vielleicht fällt jemand auch eine Verbesserung/Vereinfachung durch Umgestaltung des Formulars ein.

Die Werte werden nun direkt in die Zellen geschrieben. Nur jeweils die dritten Projekttexte erscheinen nicht in der Zelle (D34, D40 und D46, TextBoxen 18, 20 und 22).

Siehe die Bilder der Eingabemaske und der Rechnung:
   
   

komisch, jetzt ist das j doch drin, aber die beiden anderen nicht.
Nochmal ausgefüllt und es steht wieder nicht drin.

Die Musterdatei:

.xlsb   2016 Rechnungen - Rabe - Muster.xlsb (Größe: 77,43 KB / Downloads: 5)

Hier ist das Makro:
Code:
Option Explicit

Private Sub UserForm_Initialize()
  Set objWsK = ThisWorkbook.Worksheets("Kundendaten")
  Set objWs = ThisWorkbook.Worksheets("RechnungsVorlage")
 
  For Each objZeile In objWsK.UsedRange.Rows
     If objZeile.Row > 1 Then
     Me.ListBox1.AddItem objZeile.Cells(1, 2)
     End If
  Next objZeile
'   Set objWs = Nothing
  Set objZeile = Nothing
'   strDatei = ThisWorkbook.Path & "\Logo.jpg"
'   If Dir(strDatei) = "" Then               ' prüfen, ob Bild vorhanden
'   MsgBox ("Firmenlogo fehlt! " & Chr(10) & Chr(13) & strDatei)
'Else
'   Me.Image1.Picture = LoadPicture(strDatei)
'   End If
 
  With objWs                                           ' Worksheets("RechnungsVorlage")
     .Range("K21:K23,F16,C16:C21,D30:I49").ClearContents
  End With
 
'      dteReDatum = vbNullString
End Sub

Private Sub Userform_Activate()             'Userform aufrufen
  Set objWsK = ThisWorkbook.Worksheets("Kundendaten")
  Set objWs = ThisWorkbook.Worksheets("RechnungsVorlage")
 
  For i = 1 To 22
     Me.Controls("TextBox" & i) = ""
  Next
  For i = 1 To 3
     Me.Controls("Textbox" & i) = "bitte eintragen"
  Next
  Me.Controls("Textbox16") = VBA.Date
  ListBox1.SetFocus
End Sub

Private Sub CancelButton_Click()           ' Eingabe abbrechen
  For i = 1 To 22
     Me.Controls("TextBox" & i) = ""
  Next
  boAbbruch = True
 
  Unload Me
  '   Me.Hide
End Sub

Private Sub ListBox1_Click()
  TextBox1.SetFocus
End Sub

Private Sub okButton1_Click()          ' Übernehmen
  For i = 1 To 5
     If Me.Controls("TextBox" & i).Value = "" Then Exit Sub
  Next
 
  boAbbruch = False
 
  Application.ScreenUpdating = False
  '   Zelleninhalt_sichern = ActiveCell.Value
 
  'Datenzeile aus Formular ermitteln
  lngAdressZeile = ListBox1.ListIndex + 2
 
  'Kundendaten auslesen
  'KdNr    Name    Firma   Strasse Ort Land    PLZ eMail   MWSt
  strMWSt = objWsK.Cells(lngAdressZeile, 9).Value
 
  ' Kundendaten in Tabelle "RechnungsVorlage" eintragen
  With Worksheets("Datenbankliste")
     loLetzte = .Cells(Rows.Count, 1).End(xlUp).Row                     ' letzte belegte in Spalte A (1)
     strReNr = WorksheetFunction.Max(.Range("H2:H" & loLetzte)) + 1
  End With
 
  With objWs                                                 ' Worksheets("RechnungsVorlage")
     .Range("K23") = strReNr                                 ' Rechnungsnummer
     .Range("K22") = objWsK.Cells(lngAdressZeile, 1).Value   ' Kundennummer
     .Range("C16") = objWsK.Cells(lngAdressZeile, 2).Value   ' Ansprechpartner
     '.Range("F16") = objWsK.Cells(lngAdressZeile, 8).Value   ' eMail-Adresse
     .Range("C17") = objWsK.Cells(lngAdressZeile, 3).Value   ' Firma
     .Range("C18") = objWsK.Cells(lngAdressZeile, 4).Value   ' Straße
     .Range("C19") = objWsK.Cells(lngAdressZeile, 5).Value   ' Ort
     .Range("C20") = objWsK.Cells(lngAdressZeile, 6).Value   ' Land
     .Range("C21") = objWsK.Cells(lngAdressZeile, 7).Value   ' PLZ
  End With
 
  '   ActiveCell.Value = Zelleninhalt_sichern
  Application.ScreenUpdating = True
  '   Unload Me
  Me.Hide
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Bezeichnung 1-1: Text und Zahl
  If TextBox1.Value = "" Then Exit Sub
  objWs.Range("D30") = TextBox1.Value
  '   TextBox2.SetFocus
End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Bezeichnung 1-2: Text und Zahl
  If TextBox2.Value = "" Then Exit Sub
  objWs.Range("F30") = TextBox2.Value
End Sub

Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Projekttext 1-1: Text und Zahl
  If TextBox3.Value = "" Then Exit Sub
  objWs.Range("D32") = TextBox3.Value
  '   TextBox17.SetFocus
End Sub

Private Sub TextBox17_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Projekttext 1-2: Text und Zahl
  objWs.Range("D33") = TextBox17.Value
  '   TextBox18.SetFocus
End Sub

Private Sub TextBox18_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Projekttext 1-3: Text und Zahl
  objWs.Range("D34") = TextBox18.Value
  '   TextBox6.SetFocus
End Sub

Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Anzahl 1: nur Zahl
  If TextBox4.Value = "" Then Exit Sub
  If IsNumeric(TextBox4.Value) = False Then
  frmFehler.Show
  TextBox4.Value = ""
  TextBox4.SetFocus
  Cancel = True
  Exit Sub
Else
  objWs.Range("G30") = TextBox4.Value
  End If
  '   TextBox5.SetFocus
End Sub

Private Sub TextBox5_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Preis 1: nur Zahl
  If TextBox5.Value = "" Then Exit Sub
  If IsNumeric(TextBox5.Value) = False Then
  frmFehler.Show
  TextBox5.Value = ""
  TextBox5.SetFocus
  Cancel = True
  Exit Sub
Else
  objWs.Range("H30") = TextBox5.Value
  End If
  '   TextBox6.SetFocus
End Sub

Private Sub TextBox6_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Bezeichnung 2-1: Text und Zahl
  objWs.Range("D36") = TextBox6.Value
  '   TextBox7.SetFocus
End Sub

Private Sub TextBox7_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Bezeichnung 2-2: Text und Zahl
  objWs.Range("F36") = TextBox7.Value
  '   TextBox8.SetFocus
End Sub

Private Sub TextBox8_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Projekttext 2-1: Text und Zahl
  objWs.Range("D38") = TextBox8.Value
  '   TextBox19.SetFocus
End Sub

Private Sub TextBox19_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Projekttext 2-2: Text und Zahl
  objWs.Range("D39") = TextBox19.Value
  '   TextBox20.SetFocus
End Sub

Private Sub TextBox20_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Projekttext 2-3: Text und Zahl
  objWs.Range("D40") = TextBox20.Value
  '   TextBox9.SetFocus
End Sub

Private Sub TextBox9_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Anzahl 2: nur Zahl
  If IsNumeric(TextBox9.Value) = False Then
  frmFehler.Show
  TextBox9.Value = ""
  TextBox9.SetFocus
  Cancel = True
  Exit Sub
Else
  objWs.Range("G36") = TextBox9.Value
  End If
  '   TextBox10.SetFocus
End Sub

Private Sub TextBox10_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Preis 2: nur Zahl
  If IsNumeric(TextBox10.Value) = False Then
  frmFehler.Show
  TextBox10.Value = ""
  TextBox10.SetFocus
  Cancel = True
  Exit Sub
Else
  objWs.Range("H36") = TextBox10.Value
  End If
  '   TextBox11.SetFocus
End Sub

Private Sub TextBox11_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Bezeichnung 3-1: Text und Zahl
  objWs.Range("D42") = TextBox11.Value
  '   TextBox12.SetFocus
End Sub

Private Sub TextBox12_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Bezeichnung 3-2: Text und Zahl
  objWs.Range("F42") = TextBox12.Value
  '   TextBox13.SetFocus
End Sub

Private Sub TextBox13_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Projekttext 3-1: Text und Zahl
  objWs.Range("D44") = TextBox13.Value
  '   TextBox21.SetFocus
End Sub

Private Sub TextBox21_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Projekttext 3-2: Text und Zahl
  objWs.Range("D45") = TextBox21.Value
  '   TextBox22.SetFocus
End Sub

Private Sub TextBox22_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Projekttext 3-3: Text und Zahl
  objWs.Range("D46") = TextBox22.Value
  '   TextBox14.SetFocus
End Sub

Private Sub TextBox14_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Anzahl 3: nur Zahl
  objWs.Range("G42") = TextBox14.Value
  '   TextBox15.SetFocus
End Sub

Private Sub TextBox15_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Preis 3: nur Zahl
  objWs.Range("H42") = TextBox15.Value
  '   TextBox16.SetFocus
End Sub

Private Sub TextBox16_Enter()                                                               ' Datum
  '   TextBox16.Value = Date
End Sub
Private Sub TextBox16_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Datum: nur Datum
  If TextBox16.Value = "" Then Exit Sub
  If IsDate(TextBox16.Value) = False Then
  frmFehler.Show
  TextBox16.Value = ""
  TextBox16.SetFocus
  Cancel = True
  Exit Sub
Else
  objWs.Range("K21") = TextBox16.Value
  End If
End Sub
Suchen
Top
Rabe Offline
:-)
ThreadStarter
Registriert seit: 10.04.2014
Version(en): 2016 + 365
#6
17.02.2016, 22:38 (Dieser Beitrag wurde zuletzt bearbeitet: 17.02.2016, 22:38 von Rabe.)
Hi,

(17.02.2016, 13:24)Rabe schrieb: Die Werte werden nun direkt in die Zellen geschrieben. Nur jeweils die dritten Projekttexte erscheinen nicht in der Zelle (D34, D40 und D46, TextBoxen 18, 20 und 22).

Vorhin hat es mal geklappt, jetzt grad wieder nicht. Ich verzweifle noch.

Hier ist nochmal das Makro (was ist an TextBox18 anders als an 17 oder an 20 anders als an 19 oder an 22 anders als an 21?):
In der Userform sind die Textboxen einfach nur Kopien von TextBox17.
Code:
Option Explicit

Private Sub UserForm_Initialize()
  Set objWsK = ThisWorkbook.Worksheets("Kundendaten")
  Set objWs = ThisWorkbook.Worksheets("RechnungsVorlage")
 
  For Each objZeile In objWsK.UsedRange.Rows
     If objZeile.Row > 1 Then
        Me.ListBox1.AddItem objZeile.Cells(1, 2)
     End If
  Next objZeile
  '   Set objWs = Nothing
  Set objZeile = Nothing
  '   strDatei = ThisWorkbook.Path & "\Logo.jpg"
  '   If Dir(strDatei) = "" Then               ' prüfen, ob Bild vorhanden
  '   MsgBox ("Firmenlogo fehlt! " & Chr(10) & Chr(13) & strDatei)
  'Else
  '   Me.Image1.Picture = LoadPicture(strDatei)
  '   End If
 
  With objWs                                           ' Worksheets("RechnungsVorlage")
     .Range("K21:K23,F16,C16:C21,D30:I49").ClearContents
  End With
 
  '      dteReDatum = vbNullString
End Sub

Private Sub Userform_Activate()             'Userform aufrufen
  Set objWsK = ThisWorkbook.Worksheets("Kundendaten")
  Set objWs = ThisWorkbook.Worksheets("RechnungsVorlage")
 
  For i = 1 To 22
     Me.Controls("TextBox" & i) = ""
  Next
'   For i = 1 To 3
'      Me.Controls("Textbox" & i) = "bitte eintragen"
'   Next
  Me.Controls("Textbox16") = VBA.Date
  ListBox1.SetFocus
End Sub

Private Sub CancelButton_Click()           ' Eingabe abbrechen
  For i = 1 To 22
     Me.Controls("TextBox" & i) = ""
  Next
  boAbbruch = True
 
  Unload Me
  '   Me.Hide
End Sub

Private Sub ListBox1_Click()
  TextBox1.SetFocus
End Sub

Private Sub okButton1_Click()          ' Übernehmen
 
  Passwort = ""
  ActiveSheet.Unprotect Passwort
 
  For i = 1 To 5
     If Me.Controls("TextBox" & i).Value = "" Then Exit Sub
  Next
 
  boAbbruch = False
 
  Application.ScreenUpdating = False
  '   Zelleninhalt_sichern = ActiveCell.Value
 
  'Datenzeile aus Formular ermitteln
  lngAdressZeile = ListBox1.ListIndex + 2
 
  'Kundendaten auslesen
  'KdNr    Name    Firma   Strasse Ort Land    PLZ eMail   MWSt
  strMWSt = objWsK.Cells(lngAdressZeile, 9).Value
 
  ' Kundendaten in Tabelle "RechnungsVorlage" eintragen
  With Worksheets("Datenbankliste")
     loLetzte = .Cells(Rows.Count, 1).End(xlUp).Row                     ' letzte belegte in Spalte A (1)
     strReNr = WorksheetFunction.Max(.Range("H2:H" & loLetzte)) + 1
  End With
 
  With objWs                                                 ' Worksheets("RechnungsVorlage")
     .Range("K23") = strReNr                                 ' Rechnungsnummer
     .Range("K22") = objWsK.Cells(lngAdressZeile, 1).Value   ' Kundennummer
     .Range("C16") = objWsK.Cells(lngAdressZeile, 2).Value   ' Ansprechpartner
     '.Range("F16") = objWsK.Cells(lngAdressZeile, 8).Value   ' eMail-Adresse
     .Range("C17") = objWsK.Cells(lngAdressZeile, 3).Value   ' Firma
     .Range("C18") = objWsK.Cells(lngAdressZeile, 4).Value   ' Straße
     .Range("C19") = objWsK.Cells(lngAdressZeile, 5).Value   ' Ort
     .Range("C20") = objWsK.Cells(lngAdressZeile, 6).Value   ' Land
     .Range("C21") = objWsK.Cells(lngAdressZeile, 7).Value   ' PLZ
  End With
 
  '   ActiveCell.Value = Zelleninhalt_sichern
  Application.ScreenUpdating = True
  '   Unload Me
  Me.Hide
'   ActiveSheet.Protect Passwort
 
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Bezeichnung 1-1: Text und Zahl
  If TextBox1.Value = "" Then Exit Sub
  objWs.Range("D30") = TextBox1.Value
  '   TextBox2.SetFocus
End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Bezeichnung 1-2: Text und Zahl
  If TextBox2.Value = "" Then Exit Sub
  objWs.Range("F30") = TextBox2.Value
End Sub

Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Projekttext 1-1: Text und Zahl
  If TextBox3.Value = "" Then Exit Sub
  objWs.Range("D32") = TextBox3.Value
  '   TextBox17.SetFocus
End Sub

Private Sub TextBox17_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Projekttext 1-2: Text und Zahl
  objWs.Range("D33") = TextBox17.Value
  '   TextBox18.SetFocus
End Sub

Private Sub TextBox18_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Projekttext 1-3: Text und Zahl
  objWs.Range("D34") = TextBox18.Value
  '   TextBox6.SetFocus
End Sub

Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Anzahl 1: nur Zahl
  If TextBox4.Value = "" Then Exit Sub
  If IsNumeric(TextBox4.Value) = False Then
     frmFehler.Show
     TextBox4.Value = ""
     TextBox4.SetFocus
     Cancel = True
     Exit Sub
  Else
     objWs.Range("G30") = TextBox4.Value
  End If
  '   TextBox5.SetFocus
End Sub

Private Sub TextBox5_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Preis 1: nur Zahl
  If TextBox5.Value = "" Then Exit Sub
  If IsNumeric(TextBox5.Value) = False Then
     frmFehler.Show
     TextBox5.Value = ""
     TextBox5.SetFocus
     Cancel = True
     Exit Sub
  Else
     objWs.Range("H30") = TextBox5.Value
  End If
  '   TextBox6.SetFocus
End Sub

Private Sub TextBox6_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Bezeichnung 2-1: Text und Zahl
  objWs.Range("D36") = TextBox6.Value
  '   TextBox7.SetFocus
End Sub

Private Sub TextBox7_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Bezeichnung 2-2: Text und Zahl
  objWs.Range("F36") = TextBox7.Value
  '   TextBox8.SetFocus
End Sub

Private Sub TextBox8_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Projekttext 2-1: Text und Zahl
  objWs.Range("D38") = TextBox8.Value
  '   TextBox19.SetFocus
End Sub

Private Sub TextBox19_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Projekttext 2-2: Text und Zahl
  objWs.Range("D39") = TextBox19.Value
  '   TextBox20.SetFocus
End Sub

Private Sub TextBox20_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Projekttext 2-3: Text und Zahl
  objWs.Range("D40") = TextBox20.Value
  '   TextBox9.SetFocus
End Sub

Private Sub TextBox9_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Anzahl 2: nur Zahl
  If IsNumeric(TextBox9.Value) = False Then
     frmFehler.Show
     TextBox9.Value = ""
     TextBox9.SetFocus
     Cancel = True
     Exit Sub
  Else
     objWs.Range("G36") = TextBox9.Value
  End If
  '   TextBox10.SetFocus
End Sub

Private Sub TextBox10_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Preis 2: nur Zahl
  If IsNumeric(TextBox10.Value) = False Then
     frmFehler.Show
     TextBox10.Value = ""
     TextBox10.SetFocus
     Cancel = True
     Exit Sub
  Else
     objWs.Range("H36") = TextBox10.Value
  End If
  '   TextBox11.SetFocus
End Sub

Private Sub TextBox11_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Bezeichnung 3-1: Text und Zahl
  objWs.Range("D42") = TextBox11.Value
  '   TextBox12.SetFocus
End Sub

Private Sub TextBox12_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Bezeichnung 3-2: Text und Zahl
  objWs.Range("F42") = TextBox12.Value
  '   TextBox13.SetFocus
End Sub

Private Sub TextBox13_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Projekttext 3-1: Text und Zahl
  objWs.Range("D44") = TextBox13.Value
  '   TextBox21.SetFocus
End Sub

Private Sub TextBox21_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Projekttext 3-2: Text und Zahl
  objWs.Range("D45") = TextBox21.Value
  '   TextBox22.SetFocus
End Sub

Private Sub TextBox22_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Projekttext 3-3: Text und Zahl
  objWs.Range("D46") = TextBox22.Value
  '   TextBox14.SetFocus
End Sub

Private Sub TextBox14_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Anzahl 3: nur Zahl
  objWs.Range("G42") = TextBox14.Value
  '   TextBox15.SetFocus
End Sub

Private Sub TextBox15_Exit(ByVal Cancel As MSForms.ReturnBoolean)                            ' Preis 3: nur Zahl
  objWs.Range("H42") = TextBox15.Value
  '   TextBox16.SetFocus
End Sub

Private Sub TextBox16_Enter()                                                               ' Datum
  '   TextBox16.Value = Date
End Sub
Private Sub TextBox16_Exit(ByVal Cancel As MSForms.ReturnBoolean)                           ' Datum: nur Datum
  If TextBox16.Value = "" Then Exit Sub
  If IsDate(TextBox16.Value) = False Then
     frmFehler.Show
     TextBox16.Value = ""
     TextBox16.SetFocus
     Cancel = True
     Exit Sub
  Else
     objWs.Range("K21") = TextBox16.Value
  End If
End Sub

Hier die Musterdatei zum Spielen:

.xlsb   2016 Rechnungen - Rabe - Muster.xlsb (Größe: 85,01 KB / Downloads: 8)
Suchen
Top
atilla Abwesend
....
Registriert seit: 14.04.2014
Version(en): 2003, 2007
#7
17.02.2016, 23:39
Hallo Ralf,

ist ein eigenartiges Verhalten, was man da beobachten kann.
Das Exit Eriegnis tritt nicht ein, wenn man ein Steuerelement außerhalb des Frames ansteuert, auf dem das Steuerelement platziert ist.
Deshalb wird nichts in die Zellen geschrieben.

Diese Vorgehensweise ist aber generell nicht empfehlenswert. Wenn, dann sollte nach Klick auf OK geprüft werden, ob alles richtig eingetragen ist und danach alles an die richtigen Stellen eingetragen werden. Also die ganzen Exit Ereignisse der Textboxen sollten weg.

Dann würde ich aber auf diese Userform ganz verzichten.
ich würde ein Eingabeformular in der Tabelle ertsellen.
Dort mit Datengültigkeit bestimmte Dinge schon elegant abfangen.

Nach dem Ausfüllen der Formulars würde ich dann mit Schaltfläsche Klick auf Plausibilität und Pflichtfelder prüfen und die Daten an den Rechnungsausdruck übergeben und in der Datenliste die Daten sammeln.

Das hat viele Vorteile. Das Programmieren wird erleichtert. Der Code wird schneller arbeiten, da man auf zusammenhängende Bereiche zurückgreifen kann.
Die Eingabe in der Tabelle ist um ein vielfaches einfacher und schneller als in Textboxen einer Userform.
Du kannst nach Blattschutz einfach mit der Tab Taste Dich in den Eingabefeldern bewegen.

So eine Userform macht auf Anfänger oft großen Eindruck, das war anfangs bei mir nicht anders. Ich wollte auch unbedingt nach Möglichkeit alles mit Userformen bedienen.
Vieles, was in der Tabelle selbstverständlich und einfach regelbar ist (Formate, Datengültigkeit besonders Datums oder Zeitangaben) musste ich umständlich und aufwendig programmieren. Was passiert bei Dir, wenn in die Textboxen für preis und Einheit versehentlich ein Buchstabe mit rein kommt?

Userformen machen am meisten Sinn, wenn man dort nach Möglichkeit nur mit der Maus und der Tab Taste arbeiten kann.

Langer Rede kurzer Sinn, mach Dir Gedanken, ob Du das so weiter führen möchtest, oder nicht doch anders aufziehst.
Da ich nicht so viel Zeit habe, kann ich Dir leider kein Beispiel einstellen.

Was zum weiterführen auf bisheriger Basis spricht, Du wirst noch sehr viele neue programmiertechnische Dinge lernen. Auch Dinge die einen zum Verzweifeln bringen, so wie jetzt mit den Textboxen.
Gruß Atilla
[-] Folgende(r) 1 Nutzer sagt Danke an atilla für diesen Beitrag:
  • Rabe
Suchen
Top
Rabe Offline
:-)
ThreadStarter
Registriert seit: 10.04.2014
Version(en): 2016 + 365
#8
18.02.2016, 00:09
Hi atilla,

(17.02.2016, 23:39)atilla schrieb: ist ein eigenartiges Verhalten, was man da beobachten kann.
Das Exit Ereignis tritt nicht ein, wenn man ein Steuerelement außerhalb des Frames ansteuert, auf dem das Steuerelement platziert ist.
Deshalb wird nichts in die Zellen geschrieben.

danke für die ausführliche Erklärung.
Ich glaube, mir ist das jetzt zu aufwendig, alles auf ein Formular umzustellen.

Durch Deine Erklärung bin ich auch auf die Idee gekommen, die ganzen Textboxen aus den Frames herauszunehmen und die Frames zu löschen. Nun funktioniert es!
Suchen
Top
Thema geschlossen 


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste