Mmmh... Also ich finde nichts und dennoch will es nicht. Ich füge dann doch mal meinen Code und die Datei bei. Mit Sicherheit muss ich den noch aufräumen. Ich will auch gar nicht erst behaupten, dass ich hier viel selber "programmiert" hätte. Dafür fehlt mir dann doch noch das Verständnis... Hoffe Ihr könnt mal drüber schauen und vielleicht findet wer das Problem.
Code:
Option Explicit
Dim rngFind As Range
Private Sub CommandButton10_Click() 'Formular löschen!######
Dim ctrElement As Control
For Each ctrElement In Controls
Select Case TypeName(ctrElement)
Case "TextBox": ctrElement = ""
Case "ListBox": ctrElement = ""
End Select
Next
'Textfelder, Schalter sperren, entsperren und sichtbar und unsichtbar machen
CommandButton1.Visible = True
CommandButton10.Visible = False
CommandButton2.Visible = True
CommandButton11.Visible = False
CommandButton7.Visible = True
CommandButton12.Visible = False
CommandButton9.Visible = True
CommandButton18.Visible = False
TextBox1.Visible = True
TextBox24.Visible = False
TextBox2.Visible = True
TextBox25.Visible = False
TextBox3.Visible = True
TextBox26.Visible = False
ListBox1.Clear
End Sub
Private Sub CommandButton11_Click() 'Formular löschen!######
Dim ctrElement As Control
For Each ctrElement In Controls
Select Case TypeName(ctrElement)
Case "TextBox": ctrElement = ""
Case "ListBox": ctrElement = ""
End Select
Next
'Textfelder, Schalter sperren, entsperren und sichtbar und unsichtbar machen
CommandButton1.Visible = True
CommandButton10.Visible = False
CommandButton2.Visible = True
CommandButton11.Visible = False
CommandButton7.Visible = True
CommandButton12.Visible = False
TextBox1.Visible = True
TextBox24.Visible = False
TextBox2.Visible = True
TextBox25.Visible = False
TextBox27.Visible = False
TextBox3.Visible = True
TextBox26.Visible = False
TextBox28.Visible = False
ListBox1.Clear
End Sub
Private Sub CommandButton12_Click() 'Formular löschen!######
Dim ctrElement As Control
For Each ctrElement In Controls
Select Case TypeName(ctrElement)
Case "TextBox": ctrElement = ""
'Case "ListBox": ctrElement = ""
End Select
Next
'Textfelder, Schalter sperren, entsperren und sichtbar und unsichtbar machen
CommandButton1.Visible = True
CommandButton10.Visible = False
CommandButton2.Visible = True
CommandButton11.Visible = False
CommandButton7.Visible = True
CommandButton12.Visible = False
TextBox1.Visible = True
TextBox24.Visible = False
TextBox2.Visible = True
TextBox25.Visible = False
TextBox3.Visible = True
TextBox26.Visible = False
ListBox1.Clear
End Sub
Private Sub CommandButton13_Click() 'Änderungen an Daten speichern
'
' ändern
'
Dim lLetzte As Long
Dim ctrElement As Control
If TextBox27.Text = "" Then
MsgBox "Sie müssen Aktenzeichen eingeben - Danke.", _
48, " Hinweis für " & Application.UserName
TextBox27.SetFocus
Exit Sub
End If
If TextBox28.Text = "" Then
MsgBox "Sie müssen einen Namen eingeben - Danke.", _
48, " Hinweis für " & Application.UserName
TextBox28.SetFocus
Exit Sub
End If
If TextBox29.Text = "" Then
MsgBox "Sie müssen einen Vornamen eingeben - Danke.", _
48, " Hinweis für " & Application.UserName
TextBox28.SetFocus
Exit Sub
End If
'
' die Daten sind geprüft und können in die Tabelle eingetragen werden
'
Application.ScreenUpdating = True
With Worksheets("Daten_WS")
rngFind.Offset(0, 1).Value = WorksheetFunction.Proper(TextBox27.Text)
rngFind.Offset(0, 2).Value = WorksheetFunction.Proper(TextBox28.Text)
rngFind.Offset(0, 3).Value = WorksheetFunction.Proper(TextBox29.Text)
rngFind.Offset(0, 4).Value = WorksheetFunction.Proper(TextBox30.Text)
rngFind.Offset(0, 5).Value = WorksheetFunction.Proper(TextBox31.Text)
rngFind.Offset(0, 6).Value = WorksheetFunction.Proper(TextBox32.Text)
rngFind.Offset(0, 7).Value = WorksheetFunction.Proper(TextBox33.Text)
rngFind.Offset(0, 8).Value = WorksheetFunction.Proper(TextBox34.Text)
rngFind.Offset(0, 9).Value = WorksheetFunction.Proper(TextBox35.Text)
rngFind.Offset(0, 10).Value = WorksheetFunction.Proper(TextBox36.Text)
rngFind.Offset(0, 11).Value = WorksheetFunction.Proper(TextBox37.Text)
rngFind.Offset(0, 12).Value = WorksheetFunction.Proper(TextBox38.Text)
rngFind.Offset(0, 13).Value = WorksheetFunction.Proper(TextBox39.Text)
rngFind.Offset(0, 14).Value = WorksheetFunction.Proper(TextBox40.Text)
rngFind.Offset(0, 15).Value = WorksheetFunction.Proper(TextBox41.Text)
lLetzte = IIf(.Range("A65536") <> "", 65536, .Range("A65536").End(xlUp).Row) + 1
If lLetzte < 2 Then lLetzte = 2
End With
'Application.ScreenUpdating = True
'Formular Löschen
For Each ctrElement In Controls
Select Case TypeName(ctrElement)
Case "TextBox": ctrElement = ""
'Case "ListBox": ctrElement = ""
End Select
Next
'Listbox löschen
ListBox1.Clear
'Textfelder, Schalter sperren, entsperren und sichtbar und unsichtbar machen
TextBox1.Visible = True
TextBox2.Visible = True
TextBox3.Visible = True
TextBox4.Visible = True
TextBox5.Visible = True
TextBox6.Visible = True
TextBox7.Visible = True
TextBox8.Visible = True
TextBox9.Visible = True
TextBox10.Visible = True
TextBox11.Visible = True
TextBox12.Visible = True
TextBox13.Visible = True
TextBox14.Visible = True
TextBox15.Visible = True
TextBox16.Visible = True
TextBox24.Visible = False
TextBox25.Visible = False
TextBox26.Visible = False
TextBox27.Visible = False
TextBox28.Visible = False
TextBox29.Visible = False
TextBox30.Visible = False
TextBox31.Visible = False
TextBox32.Visible = False
TextBox33.Visible = False
TextBox34.Visible = False
TextBox35.Visible = False
TextBox36.Visible = False
TextBox37.Visible = False
TextBox38.Visible = False
TextBox39.Visible = False
TextBox40.Visible = False
TextBox41.Visible = False
CommandButton9.Visible = False
CommandButton18.Visible = True
CommandButton10.Visible = True
CommandButton11.Visible = True
CommandButton12.Visible = True
CommandButton13.Visible = False
CommandButton6.Visible = False
CommandButton1.Visible = True
CommandButton10.Visible = False
CommandButton2.Visible = True
CommandButton11.Visible = False
CommandButton7.Visible = True
CommandButton12.Visible = False
End Sub
Private Sub CommandButton3_Click()
'Variable deklarieren
Dim letzte_Zeile As Long
With Worksheets("Daten_WS")
'Die letzte beschrieben Zeile in Spalte A ermitteln
letzte_Zeile = .Range("A65536").End(xlUp).Offset(1, 0).Row
'Eintrag aus TextBox1 (W-Listen-Nr.) in erste freie Zelle übertragen
.Cells(letzte_Zeile, 1) = TextBox1.Text
'Eintrag aus TextBox2 (Aktenzeichen) in erste frei Zeile übertragen
.Cells(letzte_Zeile, 2) = TextBox2.Text
'Eintrag aus TextBox3 (Name) in erste frei Zeile übertragen
.Cells(letzte_Zeile, 3) = TextBox3.Text
'Eintrag aus TextBox4 (Vorname) in erste freie Zelle übertragen
.Cells(letzte_Zeile, 4) = TextBox4.Text
'Eintrag aus TextBox5 (Wohn A/B/C) in erste freie Zelle übertragen
.Cells(letzte_Zeile, 5) = TextBox5.Text
'Eintrag aus TextBox6 (Bescheid vom) in erste freie Zelle übertragen
.Cells(letzte_Zeile, 6) = TextBox6.Text
'Eintrag aus TextBox7 (Bescheid Nr.) in erste freie Zelle übertragen
.Cells(letzte_Zeile, 7) = TextBox7.Text
'Eintrag aus TextBox8 (Widerspruchsrate) in erste freie Zelle übertragen
.Cells(letzte_Zeile, 8) = TextBox8.Text
'Eintrag aus TextBox9 (Rückforderung) in erste freie Zelle übertragen
.Cells(letzte_Zeile, 9) = TextBox9.Text
'Eintrag aus TextBox10 (Widerspruch vom) in erste freie Zelle übertragen
.Cells(letzte_Zeile, 10) = TextBox10.Text
'Eintrag aus TextBox11(Eingang 1. Instanz) in erste freie Zelle übertragen
.Cells(letzte_Zeile, 11) = TextBox11.Text
'Eintrag aus TextBox12 (Eingang 2. Instanz) in erste freie Zelle übertragen
.Cells(letzte_Zeile, 12) = TextBox12.Text
'Eintrag aus TextBox13 (Erledigt am) in erste freie Zelle übertragen
.Cells(letzte_Zeile, 13) = TextBox13.Text
'Eintrag aus TextBox14 (Erledigungsart) in erste freie Zelle übertragen
.Cells(letzte_Zeile, 14) = TextBox14.Text
'Eintrag aus TextBox15 (Standort) in erste freie Zelle übertragen
.Cells(letzte_Zeile, 15) = TextBox15.Text
'Eintrag aus TextBox16 (Vermerk) in erste freie Zelle übertragen
.Cells(letzte_Zeile, 16) = TextBox16.Text
End With
ClearAll
End Sub
Private Sub CommandButton14_Click()
Unload Me
UserForm4.Show
End Sub
Private Sub CommandButton15_Click()
Unload Me
UserForm1.Show
End Sub
Private Sub CommandButton18_Click()
TextBox1.Visible = False
TextBox2.Visible = False
TextBox3.Visible = False
TextBox4.Visible = False
TextBox5.Visible = False
TextBox6.Visible = False
TextBox7.Visible = False
TextBox8.Visible = False
TextBox9.Visible = False
TextBox10.Visible = False
TextBox11.Visible = False
TextBox12.Visible = False
TextBox13.Visible = False
TextBox14.Visible = False
TextBox15.Visible = False
TextBox16.Visible = False
TextBox24.Visible = True
TextBox25.Visible = False
TextBox26.Visible = False
TextBox27.Visible = True
TextBox28.Visible = True
TextBox29.Visible = True
TextBox30.Visible = True
TextBox31.Visible = True
TextBox32.Visible = True
TextBox33.Visible = True
TextBox34.Visible = True
TextBox35.Visible = True
TextBox36.Visible = True
TextBox37.Visible = True
TextBox38.Visible = True
TextBox39.Visible = True
TextBox40.Visible = True
TextBox41.Visible = True
CommandButton9.Visible = True
CommandButton18.Visible = False
CommandButton10.Visible = False
CommandButton11.Visible = False
CommandButton12.Visible = False
CommandButton13.Visible = True
CommandButton6.Visible = True
End Sub
Private Sub CommandButton5_Click()
If TextBox1.Text = "" Then
'UserForm schließen
Unload UserForm2
Exit Sub
Else
If MsgBox("Den angezeigten Datensatz speichern ?", 36, "Sicherheitsabfrage") = vbYes Then
CommandButton3_Click
End If
Unload UserForm1
End If
End Sub
Private Sub CommandButton1_Click()
Dim sSearch As String
'Datensatz suchen
If TextBox1.Text = "" Then
MsgBox "Geben Sie bitte eine W-Listen-Nr. ein !"
Exit Sub
Else
sSearch = TextBox1.Text
Set rngFind = Columns("A:A").Find(what:=sSearch, lookat:=xlWhole, LookIn:=xlValues)
If rngFind Is Nothing Then
If MsgBox("Diese W-Listen-Nr. existiert noch nicht !" & vbCrLf & vbCrLf & " Möchten Sie eine neue P-Nr. anlegen ?", vbQuestion + vbYesNo, "Nachfragen") = vbNo Then
TextBox1.Text = ""
TextBox1.SetFocus
Exit Sub
End If
Else
TextBox24.Text = rngFind.Offset(0, 0).Value
TextBox25.Text = rngFind.Offset(0, 1).Value
TextBox27.Text = rngFind.Offset(0, 1).Value
TextBox26.Text = rngFind.Offset(0, 2).Value
TextBox28.Text = rngFind.Offset(0, 2).Value
TextBox4.Text = rngFind.Offset(0, 3).Value
TextBox29.Text = rngFind.Offset(0, 3).Value
TextBox5.Text = rngFind.Offset(0, 4).Value
TextBox30.Text = rngFind.Offset(0, 4).Value
TextBox6.Text = rngFind.Offset(0, 5).Value
TextBox31.Text = rngFind.Offset(0, 5).Value
TextBox7.Text = rngFind.Offset(0, 6).Value
TextBox32.Text = rngFind.Offset(0, 6).Value
TextBox8.Text = rngFind.Offset(0, 7).Value
TextBox33.Text = rngFind.Offset(0, 7).Value
TextBox9.Text = rngFind.Offset(0, 8).Value
TextBox34.Text = rngFind.Offset(0, 8).Value
TextBox10.Text = rngFind.Offset(0, 9).Value
TextBox35.Text = rngFind.Offset(0, 9).Value
TextBox11.Text = rngFind.Offset(0, 10).Value
TextBox36.Text = rngFind.Offset(0, 10).Value
TextBox12.Text = rngFind.Offset(0, 11).Value
TextBox37.Text = rngFind.Offset(0, 11).Value
TextBox13.Text = rngFind.Offset(0, 12).Value
TextBox38.Text = rngFind.Offset(0, 12).Value
TextBox14.Text = rngFind.Offset(0, 13).Value
TextBox39.Text = rngFind.Offset(0, 13).Value
TextBox15.Text = rngFind.Offset(0, 14).Value
TextBox40.Text = rngFind.Offset(0, 14).Value
TextBox16.Text = rngFind.Offset(0, 15).Value
TextBox41.Text = rngFind.Offset(0, 15).Value
End If
End If
sSearch = ""
'Änderung Sichtbarkeiten Button und Textbox bei Auslösung "Suchen"
CommandButton1.Visible = False
CommandButton10.Visible = True
CommandButton2.Visible = False
CommandButton11.Visible = True
CommandButton7.Visible = False
CommandButton12.Visible = True
CommandButton9.Visible = False
CommandButton18.Visible = True
TextBox1.Visible = False
TextBox24.Visible = True
TextBox2.Visible = False
TextBox25.Visible = True
TextBox27.Visible = False
TextBox3.Visible = False
TextBox26.Visible = True
TextBox28.Visible = False
End Sub
Private Sub CommandButton2_Click()
Dim sSearch As String
Dim firstAddress
Dim i As Integer
'Datensatz suchen
If TextBox2.Text = "" Then
MsgBox "Geben Sie bitte ein Aktenzeichen ein !"
Exit Sub
Else
sSearch = TextBox2.Text
Set rngFind = Columns("B:B").Find(what:=sSearch, lookat:=xlWhole, LookIn:=xlValues)
If rngFind Is Nothing Then
If MsgBox("Dieses Aktenzeichen existiert noch nicht !" & vbCrLf & vbCrLf & " Möchten Sie das Aktenzeichen anlegen ?", vbQuestion + vbYesNo, "Nachfragen") = vbNo Then
TextBox2.Text = ""
TextBox2.SetFocus
Exit Sub
End If
Else
i = 0
firstAddress = rngFind.Address
Do
ListBox1.AddItem
ListBox1.List(i, 0) = rngFind.Offset(0, -1).Value
ListBox1.List(i, 1) = rngFind
ListBox1.List(i, 2) = rngFind.Offset(0, 1).Value
ListBox1.List(i, 3) = rngFind.Offset(0, 2).Value
Set rngFind = Columns("B:B").FindNext(rngFind)
i = i + 1
Loop While Not rngFind Is Nothing And rngFind.Address <> firstAddress
End If
End If
If ListBox1.ListCount = 2 Then
TextBox1.Text = rngFind.Offset(0, 0).Value
TextBox2.Text = rngFind.Offset(0, 1).Value
TextBox3.Text = rngFind.Offset(0, 4).Value
TextBox4.Text = rngFind.Offset(0, 5).Value
TextBox5.Text = rngFind.Offset(0, 2).Value
TextBox6.Text = rngFind.Offset(0, 5).Value
TextBox7.Text = rngFind.Offset(0, 6).Value
TextBox8.Text = rngFind.Offset(0, 7).Value
TextBox9.Text = rngFind.Offset(0, 8).Value
TextBox10.Text = rngFind.Offset(0, 9).Value
TextBox11.Text = rngFind.Offset(0, 10).Value
TextBox12.Text = rngFind.Offset(0, 11).Value
TextBox13.Text = rngFind.Offset(0, 12).Value
TextBox14.Text = rngFind.Offset(0, 13).Value
TextBox15.Text = rngFind.Offset(0, 14).Value
TextBox16.Text = rngFind.Offset(0, 15).Value
TextBox24.Text = rngFind.Offset(0, 0).Value
ListBox1.Clear
End If
'Änderung Sichtbarkeiten Button und Textbox bei Auslösung "Suchen"
CommandButton1.Visible = False
CommandButton10.Visible = True
CommandButton2.Visible = False
CommandButton11.Visible = True
CommandButton7.Visible = False
CommandButton12.Visible = True
TextBox1.Visible = False
TextBox24.Visible = True
TextBox2.Visible = False
TextBox25.Visible = True
TextBox27.Visible = False
TextBox3.Visible = False
TextBox26.Visible = True
End Sub
Private Sub CommandButton7_Click()
Dim sSearch As String
Dim firstAddress
Dim i As Integer
'Datensatz suchen
If TextBox3.Text = "" Then
MsgBox "Geben Sie bitte einen Namen ein !"
Exit Sub
Else
sSearch = TextBox3.Text
Set rngFind = Columns("C:C").Find(what:=sSearch, lookat:=xlWhole, LookIn:=xlValues)
If rngFind Is Nothing Then
If MsgBox("Dieser Name existiert noch nicht !" & vbCrLf & vbCrLf & " Möchten Sie einen neuen Namen anlegen ?", vbQuestion + vbYesNo, "Nachfragen") = vbNo Then
TextBox3.Text = ""
TextBox3.SetFocus
Exit Sub
End If
Else
i = 0
firstAddress = rngFind.Address
Do
ListBox1.AddItem
ListBox1.List(i, 0) = rngFind.Offset(0, -2).Value
ListBox1.List(i, 1) = rngFind.Offset(0, -1).Value
ListBox1.List(i, 2) = rngFind
ListBox1.List(i, 3) = rngFind.Offset(0, 1).Value
Set rngFind = Columns("c:c").FindNext(rngFind)
i = i + 1
Loop While Not rngFind Is Nothing And rngFind.Address <> firstAddress
End If
End If
If ListBox1.ListCount = 1 Then
TextBox1.Text = rngFind.Offset(0, -2).Value
TextBox2.Text = rngFind.Offset(0, -1).Value
TextBox3.Text = rngFind.Offset(0, 0).Value
TextBox4.Text = rngFind.Offset(0, 1).Value
ListBox1.Clear
End If
'Textfelder, Schalter sperren, entsperren und sichtbar und unsichtbar machen
CommandButton1.Visible = False
CommandButton10.Visible = True
CommandButton2.Visible = False
CommandButton11.Visible = True
CommandButton7.Visible = False
CommandButton12.Visible = True
TextBox1.Visible = False
TextBox24.Visible = True
TextBox2.Visible = False
TextBox25.Visible = True
TextBox27.Visible = False
TextBox3.Visible = False
TextBox26.Visible = True
End Sub
Private Sub CommandButton6_Click() 'Formular löschen!######
Dim ctrElement As Control
For Each ctrElement In Controls
Select Case TypeName(ctrElement)
Case "TextBox": ctrElement = ""
'Case "ListBox": ctrElement = ""
End Select
Next
'Textfelder, Schalter sperren, entsperren und sichtbar und unsichtbar machen
CommandButton1.Visible = True
CommandButton10.Visible = False
CommandButton2.Visible = True
CommandButton11.Visible = False
CommandButton7.Visible = True
CommandButton12.Visible = False
TextBox1.Visible = True
TextBox24.Visible = False
TextBox2.Visible = True
TextBox25.Visible = False
TextBox3.Visible = True
TextBox26.Visible = False
ListBox1.Clear
End Sub
Private Sub CommandButton8_Click()
'UserForm schließen und anderes UserForm starten#####
UserForm2.Hide
UserForm5.Show
'#####
End Sub
Private Sub CommandButton9_Click()
End Sub
Private Sub ListBox1_Click()
Dim sSearch As String
If ListBox1.ListCount > 1 Then
sSearch = ListBox1.List(ListBox1.ListIndex, 0)
Set rngFind = Columns("A:A").Find(what:=sSearch, lookat:=xlWhole, LookIn:=xlValues)
If Not rngFind Is Nothing Then
TextBox4.Text = rngFind.Offset(0, 3).Value
TextBox5.Text = rngFind.Offset(0, 4).Value
TextBox6.Text = rngFind.Offset(0, 5).Value
TextBox7.Text = rngFind.Offset(0, 6).Value
TextBox8.Text = rngFind.Offset(0, 7).Value
TextBox9.Text = rngFind.Offset(0, 8).Value
TextBox10.Text = rngFind.Offset(0, 9).Value
TextBox11.Text = rngFind.Offset(0, 10).Value
TextBox12.Text = rngFind.Offset(0, 11).Value
TextBox13.Text = rngFind.Offset(0, 12).Value
TextBox14.Text = rngFind.Offset(0, 13).Value
TextBox15.Text = rngFind.Offset(0, 14).Value
TextBox16.Text = rngFind.Offset(0, 15).Value
TextBox24.Text = rngFind.Offset(0, 0).Value
TextBox25.Text = rngFind.Offset(0, 1).Value
TextBox27.Text = rngFind.Offset(0, 1).Value
TextBox26.Text = rngFind.Offset(0, 2).Value
TextBox28.Text = rngFind.Offset(0, 2).Value
TextBox29.Text = rngFind.Offset(0, 3).Value
End If
sSearch = ""
End If
'Textfelder, Schalter sperren, entsperren und sichtbar und unsichtbar machen
CommandButton18.Visible = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'Fehlermeldung, wenn versucht wird, die UserForm über das
'Schließenkreuz oben rechts zu schließen
If CloseMode = 0 Then
Cancel = 1
MsgBox "Bitte verlassen Sie die Eingabemaske nur mit der Schaltfläche - Beenden.", _
vbOKOnly + vbInformation, "Bitte Schaltfläche betätigen."
End If
End Sub
Public Sub UserForm_Initialize()
On Error GoTo EERR
With UserForm1
.Height = 700
.Width = 900
End With
'Variable deklarieren
Dim Wiederholungen As Integer
Sheets("Daten_WS").Select
TextBox1.Text = ""
TextBox1.SetFocus
'Textfelder, Schalter sperren, entsperren und sichtbar und unsichtbar machen
CommandButton1.Default = False
CommandButton10.Visible = False
CommandButton11.Visible = False
CommandButton12.Visible = False
TextBox24.Visible = False
TextBox25.Visible = False
TextBox26.Visible = False
TextBox27.Visible = False
TextBox28.Visible = False
TextBox29.Visible = False
TextBox30.Visible = False
TextBox31.Visible = False
TextBox32.Visible = False
TextBox33.Visible = False
TextBox34.Visible = False
TextBox35.Visible = False
TextBox36.Visible = False
TextBox37.Visible = False
TextBox38.Visible = False
TextBox39.Visible = False
TextBox40.Visible = False
TextBox41.Visible = False
CommandButton13.Visible = False
CommandButton6.Visible = False
CommandButton18.Visible = False
CommandButton17.Visible = False
Exit Sub
EERR:
End Sub
Sub ClearAll()
Dim C As Integer
On Error Resume Next
ListBox1.Clear
For C = 1 To 2
Me.Controls("ComboBox" & CStr(C)).Text = ""
Next C
For C = 1 To 5
Me.Controls("TextBox" & CStr(C)).Text = ""
Next C
End Sub