Re: Eingabe erzwingen
03.02.2003 07:41:55
klaus
Hallo HajoWie stelle ich die Abhängigkeit her bei mehreren Boxen?
Hier mein bisheriger Code (habe erst mit VBA angefangen):
Private Sub cmdEintragen_Click()
Dim i As Byte, control As Boolean
Dim lgFreieZeile As Integer
'----------------------------------------Eingabe Kombinationsfelder---------------------------------------------
'If cboErstName.Value = "" Then
'MsgBox "Der Wert In ""Erstellt von:"" fehlt!", vbOKOnly + vbExclamation, "Fehler"
If cboErstName.Text <> "" Then
If cboErstName.ListCount > 0 Then
For i = 0 To cboErstName.ListCount - 1
If cboErstName.List(i) = cboErstName.Text Then control = True
Next i
If control Then
Worksheets("EingabeIntern").Activate
lgFreieZeile = [A65536].End(xlUp).Row + 1
Worksheets("EingabeIntern").Cells(lgFreieZeile, 9) = Controls("cboErstName").Value
Else
' Der Text ist wirklich neu und wird am Ende der Liste angefügt
Worksheets("Tabelle2").Activate
lgFreieZeile = [b65536].End(xlUp).Row + 1
Worksheets("Tabelle2").Cells(lgFreieZeile, 2) = Controls("cboErstName").Value
Worksheets("EingabeIntern").Activate
lgFreieZeile = [A65536].End(xlUp).Row + 1
Worksheets("EingabeIntern").Cells(lgFreieZeile, 9) = Controls("cboErstName").Value
End If
End If
End If
'----------------------------------------------------------------------------Kundennahme
If cboKdName.Text <> "" Then
If cboKdName.ListCount > 0 Then
For i = 0 To cboKdName.ListCount - 1
If cboKdName.List(i) = cboKdName.Text Then control = True
Next i
If control Then
Worksheets("EingabeIntern").Activate
lgFreieZeile = [A65536].End(xlUp).Row + 1
Worksheets("EingabeIntern").Cells(lgFreieZeile, 6) = Controls("cboKdName").Value
Else
' Der Text ist wirklich neu und wird am Ende der Liste angefügt
Worksheets("Tabelle2").Activate
lgFreieZeile = [c65536].End(xlUp).Row + 1
Worksheets("Tabelle2").Cells(lgFreieZeile, 3) = Controls("cboKdName").Value
Worksheets("EingabeIntern").Activate
lgFreieZeile = [A65536].End(xlUp).Row + 1
Worksheets("EingabeIntern").Cells(lgFreieZeile, 6) = Controls("cboKdName").Value
End If
End If
End If
'------------------------------------------------------------------Abteilung
If cboCfAbt.Text <> "" Then
If cboCfAbt.ListCount > 0 Then
For i = 0 To cboCfAbt.ListCount - 1
If cboCfAbt.List(i) = cboCfAbt.Text Then control = True
Next i
If control Then
Worksheets("EingabeIntern").Activate
lgFreieZeile = [A65536].End(xlUp).Row + 1
Worksheets("EingabeIntern").Cells(lgFreieZeile, 10) = Controls("cboCfAbt").Value
Else
Worksheets("Tabelle2").Activate
lgFreieZeile = [d65536].End(xlUp).Row + 1
Worksheets("Tabelle2").Cells(lgFreieZeile, 4) = Controls("cboCfAbt").Value
Worksheets("EingabeIntern").Activate
lgFreieZeile = [A65536].End(xlUp).Row + 1
Worksheets("EingabeIntern").Cells(lgFreieZeile, 10) = Controls("cboCfAbt").Value
End If
End If
End If
'--------------------------------------------------------------------------Fehler Nummer
Worksheets("EingabeIntern").Activate
lgFreieZeile = [A65536].End(xlUp).Row + 1
Worksheets("EingabeIntern").Cells(lgFreieZeile, 7) = Controls("cboFehlNr").Value
'--------------------------------------------------------------------------------Leitung
If cboLeitNam.Text <> "" Then
If cboLeitNam.ListCount > 0 Then
For i = 0 To cboLeitNam.ListCount - 1
If cboLeitNam.List(i) = cboLeitNam.Text Then control = True
Next i
If control Then
Worksheets("EingabeIntern").Activate
lgFreieZeile = [A65536].End(xlUp).Row + 1
Worksheets("EingabeIntern").Cells(lgFreieZeile, 11) = Controls("cboLeitNam").Value
Else
' Der Text ist wirklich neu und wird am Ende der Liste angefügt
Worksheets("Tabelle2").Activate
lgFreieZeile = [f65536].End(xlUp).Row + 1
Worksheets("Tabelle2").Cells(lgFreieZeile, 6) = Controls("cboLeitNam").Value
Worksheets("EingabeIntern").Activate
lgFreieZeile = [A65536].End(xlUp).Row + 1
Worksheets("EingabeIntern").Cells(lgFreieZeile, 11) = Controls("cboLeitNam").Value
End If
End If
End If
'-------------------------------------------------------------------------------Mitarbeit
If cboMitNam.Text <> "" Then
If cboMitNam.ListCount > 0 Then
For i = 0 To cboMitNam.ListCount - 1
If cboMitNam.List(i) = cboMitNam.Text Then control = True
Next i
If control Then
Worksheets("EingabeIntern").Activate
lgFreieZeile = [A65536].End(xlUp).Row + 1
Worksheets("EingabeIntern").Cells(lgFreieZeile, 12) = Controls("cboMitNam").Value
Else
Worksheets("Tabelle2").Activate
lgFreieZeile = [g65536].End(xlUp).Row + 1
Worksheets("Tabelle2").Cells(lgFreieZeile, 7) = Controls("cboMitNam").Value
Worksheets("EingabeIntern").Activate
lgFreieZeile = [A65536].End(xlUp).Row + 1
Worksheets("EingabeIntern").Cells(lgFreieZeile, 12) = Controls("cboMitNam").Value
End If
End If
End If
'-----------------------Eingabe Textfelder------------------------------------------------------------------------
If txbDat.Value = "" Then
MsgBox "Der Wert In Datum fehlt!", vbOKOnly + vbExclamation, "Fehler"
cmdEintragen.Visible = False 'ausblenden
ElseIf txbDat.Text <> "" Then
Worksheets("EingabeIntern").Activate
lgFreieZeile = [A65536].End(xlUp).Row + 1
Worksheets("EingabeIntern").Cells(lgFreieZeile, 2) = Controls("txbDat").Value
cmdEintragen.Visible = True
End If
' Atomatische Zeilennummerierung Salte 1
Worksheets("EingabeIntern").Activate
lgFreieZeile = Worksheets("EingabeIntern").Range("A65536").End(xlUp).Row + 1
Cells(lgFreieZeile, 1) = Cells(lgFreieZeile - 1, 1) + 1
End Sub
Gruß Klaus