AW: Daten aus UserForm in best. Zellbereiche
11.09.2014 12:03:55
Andreas
Hallo yummi,
erstmal vielen Dank für deine Mühe. Nochmal zum grundsätzlichen Verständnis des Ablaufs:
1. Formular wird ausgefüllt
2. Per Commandbutton wird zu einem Formularblatt gesprungen und die Werte aus der UserForm dort eingetragen - dann wird zu dem Blatt gesprungen dessen Name mit dem Wert aus Combobox1 übereinstimmt - dort werden nochmals alle Daten aus dem UserForm eingefügt (nächste leere Zeile).
Nachfolgend mein Code und die Erläuterungen dazu.
Dieser Code ist zum Vervollständigen der Textbox3 (alles Ok):
Option Explicit
' verliert die Textbox den Focus, merkt sich Excel die Eingabe
Private Const STARTSPALTE = 1
Private Const WORTE_TAB = "Strassen" ' Blatt der Werte die verglichen werden
Private tb_lock As Boolean, tmp$, rng As Range, blocke_autokorrektur As Boolean
Private bUnterdrücken As Boolean
Private wks As Worksheet
Private Sub TextBox3_Change()
Dim ln&
If blocke_autokorrektur Then
blocke_autokorrektur = False
Exit Sub
End If
If tb_lock Then Exit Sub
tb_lock = True
ln = Len(TextBox3)
tmp = Finde_Vorschlag(TextBox3.Value)
If tmp vbNullString Then
With TextBox3
.Value = tmp
.SelStart = ln
.SelLength = Len(TextBox3)
End With
End If
tb_lock = False
End Sub
Private Function Finde_Vorschlag(eingabe$) As String
Dim fa$, fd As Boolean
If eingabe = " " Or eingabe = vbNullString Then
Finde_Vorschlag = vbNullString
Exit Function
End If
With Worksheets(WORTE_TAB).Cells
Set rng = .Find(eingabe, LookIn:=xlValues, lookat:=xlPart)
If Not rng Is Nothing Then
fa = rng.Address
Do
If Left(rng.Value, Len(eingabe)) = eingabe Then
fd = True
Exit Do
End If
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address fa
If Not fd Then
Finde_Vorschlag = vbNullString
Exit Function
Else
Finde_Vorschlag = .Cells(rng.Row, rng.Column).Value
End If
End If
End With
End Function
Private Sub Textbox3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal shift As Integer)
If KeyCode = 8 Then blocke_autokorrektur = True
If Len(TextBox3) = 0 Then blocke_autokorrektur = False
End Sub
Hier gehts los:
Private Sub CommandButton1_Click()
Hier müsste die Funktion "CheckVollstaendig()" rein. Also vor oder nach "Sheets("Abholung").Activate" ---- prüfe ob alle in der Funktion angegeben Comboboxen und Textboxen einen Wert haben -- wenn nicht - dann Meldung und zum UserForm zurück -- sonst code weiter ausführen
Sheets("Abholung").Activate
Dim Zeile As Long, objControl As Control, intI As Integer, wks As Worksheet
Zeile = 21
Set wks = ActiveSheet
wks.Range("B22:B43").ClearContents
For intI = 7 To 21
Set objControl = Me.Controls("Combobox" & Format(intI, "0"))
If objControl.Text "" Then
Zeile = Zeile + 1
wks.Cells(Zeile, 2) = objControl.Text
End If
Next
For intI = 6 To 10
Set objControl = Me.Controls("Textbox" & Format(intI, "0"))
If objControl.Text "" Then
Zeile = Zeile + 1
wks.Cells(Zeile, 2) = objControl.Text
End If
Next
Range("C11") = ComboBox1.Text 'Datum
Range("F11") = ComboBox2.Text ' Von
Range("G11") = ComboBox3.Text '"bis oder ab"
Range("H11") = ComboBox4.Text 'Bis
'Range("F13").Value = ComboBox6.List(ComboBox6.ListIndex, 0) 'Dauer
Range("B14").Value = Me.TextBox1.Text 'Name
Range("B20").Value = Me.TextBox2.Text 'Telefon
Range("B16").Value = Me.TextBox3.Text & " " & Me.TextBox4.Text 'Strasse + Nummer
Range("F16") = ComboBox5.Text 'Etage
Range("B18").Value = Me.TextBox5.Text 'Ort
Range("B46").Value = Me.TextBox11.Text 'Bemerkungen
Sheets(ComboBox1.Value).Activate
Hier müssten jetzt die Funktionen "WerteEintragen1" und "WerteEintragen2" rein.
Ich habe es so probiert, funktioniert aber nicht.
'If ComboBox2
Hier habe ich den Sprung "(ComboBox1.Value)" rausgenommen, Der Sprung erfolgt über den Commandbutton, das klappt auch super, es soll auch auf das Blatt gesprungen werden.
Private Sub ComboBox1_Change()
If bUnterdrücken = False Then
bUnterdrücken = True
ComboBox1.Value = Format(ComboBox1.Value, ("dd.mm.yyyy"))
If SucheBlatt(ComboBox1.Value) = False Then
MsgBox ("Kein Tabellenblatt zum gewählten Datum vorhanden!")
Unload Me
Else
bUnterdrücken = False
'Set wks = ThisWorkbook.Sheets(ComboBox1.Value)
End If
End If
End Sub
Hier mal eine vollständige Funktion "WerteEintragen1". Verstehe ich das richtig: suche in den Zeilen 3 bis 18 die erste freie Zeile in der alle Spalten A bis Q leer ist und schreibe dann Combobox2 in Spalte 1 , Combobox3 in Spalte 2 usw?
Function WerteEintragen1()
Dim i As Long
If Not wks Is Nothing Then
For i = 3 To 18
If wks.Cells(i, 1).Value = "" Then
'eintragen und verlassen
wks.Cells(i, 1).Value = Me.ComboBox2.Value
Exit For
End If
Next i
End If
If Not wks Is Nothing Then
For i = 3 To 18
If wks.Cells(i, 2).Value = "" Then
'eintragen und verlassen
wks.Cells(i, 2).Value = Me.ComboBox3.Value
Exit For
End If
Next i
End If
If Not wks Is Nothing Then
For i = 3 To 18
If wks.Cells(i, 3).Value = "" Then
'eintragen und verlassen
wks.Cells(i, 3).Value = Me.ComboBox4.Value
Exit For
End If
Next i
End If
If Not wks Is Nothing Then
For i = 3 To 18
If wks.Cells(i, 10).Value = "" Then
'eintragen und verlassen
wks.Cells(i, 10).Value = Me.ComboBox6.List(ComboBox6.ListIndex, 0)
Exit For
End If
Next i
End If
If Not wks Is Nothing Then
For i = 3 To 18
If wks.Cells(i, 4).Value = "" Then
'eintragen und verlassen
wks.Cells(i, 4).Value = Me.Textbox1.Text
Exit For
End If
Next i
End If
If Not wks Is Nothing Then
For i = 3 To 18
If wks.Cells(i, 5).Value = "" Then
'eintragen und verlassen
wks.Cells(i, 5).Value = Me.Textbox2.Text
Exit For
End If
Next i
End If
If Not wks Is Nothing Then
For i = 3 To 18
If wks.Cells(i, 6).Value = "" Then
'eintragen und verlassen
wks.Cells(i, 6).Value = Me.TextBox3.Text
Exit For
End If
Next i
End If
If Not wks Is Nothing Then
For i = 3 To 18
If wks.Cells(i, 7).Value = "" Then
'eintragen und verlassen
wks.Cells(i, 7).Value = Me.TextBox4.Text
Exit For
End If
Next i
End If
If Not wks Is Nothing Then
For i = 3 To 18
If wks.Cells(i, 8).Value = "" Then
'eintragen und verlassen
wks.Cells(i, 8).Value = Me.TextBox5.Text
Exit For
End If
Next i
End If
If Not wks Is Nothing Then
For i = 3 To 18
If wks.Cells(i, 9).Value = "" Then
'eintragen und verlassen
wks.Cells(i, 9).Value = Me.ComboBox7.Value & " " & Me.ComboBox8.Value & " " & _
Me.ComboBox9.Value & " " &
Me.ComboBox10.Value & " " & Me.ComboBox11.Value & " " & Me.ComboBox12.Value & " " & Me. _
ComboBox13.Value & " " &
Me.ComboBox14.Value & " " & Me.ComboBox15.Value & " " & Me.ComboBox16.Value & " " & Me. _
ComboBox17.Value & " " &
Me.ComboBox18.Value & " " & Me.ComboBox19.Value & " " & Me.ComboBox20.Value & " " & Me. _
ComboBox21.Value & " " &
Me.TextBox6.Text & " " & Me.TextBox7.Text & " " & Me.TextBox8.Text & " " & Me.TextBox9.Text & " _
" & Me.TextBox10.Text
Exit For
End If
Next i
End If
If Not wks Is Nothing Then
For i = 3 To 18
If wks.Cells(i, 16).Value = "" Then
'eintragen und verlassen
wks.Cells(i, 16).Value = "x"
Exit For
End If
Next i
End If
End Function
Und hier noch die vollständige Funktion: CheckVollstaendig()
Function CheckVollstaendig() As Boolean
'das für alle Combo und Textboxen hier noch rein
If Me.ComboBox1.Value = "" Then
CheckVollstaendig = False
End If
If Me.ComboBox2.Value = "" Then
CheckVollstaendig = False
End If
If Me.ComboBox4.Value = "" Then
CheckVollstaendig = False
End If
If Me.ComboBox6.Value = "" Then
CheckVollstaendig = False
End If
If Me.TextBox1.Value = "" Then
CheckVollstaendig = False
End If
If Me.TextBox3.Value = "" Then
CheckVollstaendig = False
End If
If Me.TextBox4.Value = "" Then
CheckVollstaendig = False
End If
'ganz am Ende dann noch
CheckVollstaendig = True
End Function
Und hier noch der restliche Code:
Private Sub UserForm_Initialize()
bUnterdrücken = False
With Me.ComboBox3
.AddItem "bis"
.AddItem "ab"
.ListIndex = 0
End With
With Me.ComboBox1
.RowSource = "Userform!A3:A66"
.ListIndex = -1
End With
With Me.ComboBox2
.RowSource = "Zeit"
.ListIndex = -1
End With
With Me.ComboBox4
.RowSource = "Zeit"
.ListIndex = -1
End With
With Me.ComboBox5
.RowSource = "Etage"
.ListIndex = -1
End With
With Me.ComboBox6
.RowSource = "Dauer"
.ListIndex = -1
End With
With Me.ComboBox7
.RowSource = "Artikel"
.ListIndex = -1
End With
With Me.ComboBox8
.RowSource = "Artikel"
.ListIndex = -1
End With
With Me.ComboBox9
.RowSource = "Artikel"
.ListIndex = -1
End With
With Me.ComboBox10
.RowSource = "Artikel"
.ListIndex = -1
End With
With Me.ComboBox11
.RowSource = "Artikel"
.ListIndex = -1
End With
With Me.ComboBox12
.RowSource = "Artikel"
.ListIndex = -1
End With
With Me.ComboBox13
.RowSource = "Artikel"
.ListIndex = -1
End With
With Me.ComboBox14
.RowSource = "Artikel"
.ListIndex = -1
End With
With Me.ComboBox15
.RowSource = "Artikel"
.ListIndex = -1
End With
With Me.ComboBox16
.RowSource = "Artikel"
.ListIndex = -1
End With
With Me.ComboBox17
.RowSource = "Artikel"
.ListIndex = -1
End With
With Me.ComboBox18
.RowSource = "Artikel"
.ListIndex = -1
End With
With Me.ComboBox19
.RowSource = "Artikel"
.ListIndex = -1
End With
With Me.ComboBox20
.RowSource = "Artikel"
.ListIndex = -1
End With
With Me.ComboBox21
.RowSource = "Artikel"
.ListIndex = -1
End With
End Sub
Private Sub ComboBox2_Change()
ComboBox2.Value = Format(ComboBox2.Value, ("hh:mm"))
End Sub
Private Sub ComboBox4_Change()
ComboBox4.Value = Format(ComboBox4.Value, ("hh:mm"))
End Sub
Danke! mfg, Andreas