Ich möchte eine neue Abfrage in den bestehenden Code einer Userform einbauen. Leider klappt mir die Zusammenführung nicht richtig. Hier der derzeitige Code:
Option Explicit
Dim rngFind As Range
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal _
lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex _
As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex _
As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal _
hwnd As Long) As Long
Private Const GWL_STYLE As Long = -16
Private Const WS_SYSMENU As Long = &H80000
Private hWndForm As Long
Private bCloseBtn As Boolean
Private Sub CommandButton3_ändern_Click()
Sheets("Daten").Select
ActiveSheet.Unprotect Password:="dolphin"
'Neuen Datensatz anlegen
Dim letzte_Zeile As Long
With Worksheets("Daten")
'Die letzte beschrieben Zeile in Spalte A ermitteln
letzte_Zeile = .Range("A65536").End(xlUp).Offset(1, 0).Row
.Cells(letzte_Zeile, 1) = TextBox1.Text 'ID
.Cells(letzte_Zeile, 2) = TextBox2.Text 'Nachname
.Cells(letzte_Zeile, 3) = TextBox3.Text 'Vorname
.Cells(letzte_Zeile, 8) = TextBox4.Text 'Geburtsdatum
.Cells(letzte_Zeile, 5) = TextBox5.Text 'Adresse
.Cells(letzte_Zeile, 6) = TextBox6.Text 'PLZ
.Cells(letzte_Zeile, 7) = TextBox7.Text 'Ort
.Cells(letzte_Zeile, 4) = TextBox8.Text 'beschäftigt seit
.Cells(letzte_Zeile, 9) = TextBox9.Text 'Telefon
.Cells(letzte_Zeile, 10) = TextBox10.Text 'Mobil
.Cells(letzte_Zeile, 11) = TextBox11.Text 'E-MAil
.Cells(letzte_Zeile, 19) = TextBox12.Text 'eingearbeitet FS
.Cells(letzte_Zeile, 20) = TextBox13.Text 'eingearbeitet Bar
.Cells(letzte_Zeile, 21) = TextBox14.Text 'Konfektionsgröße
.Cells(letzte_Zeile, 22) = TextBox15.Text 'VS Tauglich
.Cells(letzte_Zeile, 25) = TextBox16.Text 'Wochenstunden
.Cells(letzte_Zeile, 26) = TextBox17.Text 'Kostenstelle
.Cells(letzte_Zeile, 27) = TextBox18.Text 'Stunden pro Monat
.Cells(letzte_Zeile, 28) = TextBox19.Text 'Überstunden
.Cells(letzte_Zeile, 24) = TextBox20.Text 'Bermerkungen
.Cells(letzte_Zeile, 12) = ComboBox1.Text 'Bereich 1
.Cells(letzte_Zeile, 13) = ComboBox2.Text 'Bereich 2
.Cells(letzte_Zeile, 14) = ComboBox3.Text 'Bereich 3
.Cells(letzte_Zeile, 15) = ComboBox5.Text 'Sprache 1
.Cells(letzte_Zeile, 16) = ComboBox6.Text 'Sprache 2
.Cells(letzte_Zeile, 17) = ComboBox7.Text 'Sprache 3
.Cells(letzte_Zeile, 18) = ComboBox8.Text 'Sprache 4
End With
ClearAll
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="dolphin"
ActiveSheet.EnableSelection = xlUnlockedCells
Unload grüne_Welle_1
Application.Run "UF_Show"
End Sub
Private Sub CommandButton3_Click()
Sheets("Daten").Select
ActiveSheet.Unprotect Password:="dolphin"
'Neuen Datensatz anlegen
Dim letzte_Zeile As Long
With Worksheets("Daten")
'Die letzte beschrieben Zeile in Spalte A ermitteln
letzte_Zeile = .Range("A65536").End(xlUp).Offset(1, 0).Row
.Cells(letzte_Zeile, 1) = TextBox1.Text 'ID
.Cells(letzte_Zeile, 2) = TextBox2.Text 'Nachname
.Cells(letzte_Zeile, 3) = TextBox3.Text 'Vorname
.Cells(letzte_Zeile, 8) = TextBox4.Text 'Geburtsdatum
.Cells(letzte_Zeile, 5) = TextBox5.Text 'Adresse
.Cells(letzte_Zeile, 6) = TextBox6.Text 'PLZ
.Cells(letzte_Zeile, 7) = TextBox7.Text 'Ort
.Cells(letzte_Zeile, 4) = TextBox8.Text 'beschäftigt seit
.Cells(letzte_Zeile, 9) = TextBox9.Text 'Telefon
.Cells(letzte_Zeile, 10) = TextBox10.Text 'Mobil
.Cells(letzte_Zeile, 11) = TextBox11.Text 'E-MAil
.Cells(letzte_Zeile, 19) = TextBox12.Text 'eingearbeitet FS
.Cells(letzte_Zeile, 20) = TextBox13.Text 'eingearbeitet Bar
.Cells(letzte_Zeile, 21) = TextBox14.Text 'Konfektionsgröße
.Cells(letzte_Zeile, 22) = TextBox15.Text 'VS Tauglich
.Cells(letzte_Zeile, 25) = TextBox16.Text 'Wochenstunden
.Cells(letzte_Zeile, 26) = TextBox17.Text 'Kostenstelle
.Cells(letzte_Zeile, 27) = TextBox18.Text 'Stunden pro Monat
.Cells(letzte_Zeile, 28) = TextBox19.Text 'Überstunden
.Cells(letzte_Zeile, 24) = TextBox20.Text 'Bermerkungen
.Cells(letzte_Zeile, 12) = ComboBox1.Text 'Bereich 1
.Cells(letzte_Zeile, 13) = ComboBox2.Text 'Bereich 2
.Cells(letzte_Zeile, 14) = ComboBox3.Text 'Bereich 3
.Cells(letzte_Zeile, 15) = ComboBox5.Text 'Sprache 1
.Cells(letzte_Zeile, 16) = ComboBox6.Text 'Sprache 2
.Cells(letzte_Zeile, 17) = ComboBox7.Text 'Sprache 3
.Cells(letzte_Zeile, 18) = ComboBox8.Text 'Sprache 4
End With
ClearAll
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="dolphin"
ActiveSheet.EnableSelection = xlUnlockedCells
Unload grüne_Welle_1
End Sub
Private Sub CommandButton5_Click()
If TextBox1.Text = "" Then
Unload grüne_Welle_1
Exit Sub
Else
If MsgBox("Den angezeigten Datensatz speichern ?", 36, "Sicherheitsabfrage") = vbYes Then
CommandButton3_Click
End If
Unload grüne_Welle_1
End If
End Sub
Private Sub CommandButton4_Click()
Dim a As Integer
Dim msg
'Datensatz löschen
a = Range(rngFind.Address).Row
If MsgBox(" Datensatz wirklich löschen", vbYesNo) = vbNo Then
Exit Sub
Else
Rows(a).Delete
End If
ClearAll
TextBox1.SetFocus
End Sub
Private Sub CommandButton6_Click()
Sheets("Daten").Select
ActiveSheet.Unprotect Password:="dolphin"
Dim aStr As Byte
If TextBox1.Text = "" Then
ClearAll
TextBox1.SetFocus
Exit Sub
Else
aStr = MsgBox(" Möchten Sie den angezeigten Datensatz" & vbCrLf & vbCrLf & vbTab & _
"- vorher speichern (Ja)" & vbCrLf & vbCrLf & vbTab & _
"- nur leeren (Nein)" & vbCrLf & vbCrLf & vbTab & _
"- nicht unternehmen (Abbrechen)", vbYesNoCancel, "Sicherheitsabfrage")
If aStr = vbYes Then
CommandButton3_ändern_Click
ElseIf aStr = vbNo Then
ClearAll
Me.TextBox1 = WorksheetFunction.Max(Range("a:a")) + 1
Else
TextBox1.SetFocus
End If
TextBox1.SetFocus
End If
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="dolphin"
ActiveSheet.EnableSelection = xlUnlockedCells
End Sub
Public Sub UserForm_Initialize()
If Val(Application.Version) >= 9 Then
hWndForm = FindWindow("ThunderDFrame", Me.Caption)
Else
hWndForm = FindWindow("ThunderXFrame", Me.Caption)
End If
bCloseBtn = False
SetUserFormStyle
ComboBox1.RowSource = "'Alter'!A2:C8"
ComboBox2.RowSource = "'Info'!B2:B9"
ComboBox3.RowSource = "'Info'!C2:C9"
ComboBox5.RowSource = "'Info'!E2:E9"
ComboBox6.RowSource = "'Info'!E2:E9"
ComboBox7.RowSource = "'Info'!E2:E9"
ComboBox8.RowSource = "'Info'!F2:F9"
Me.TextBox1 = WorksheetFunction.Max(Range("a:a")) + 1
End Sub
Private Sub SetUserFormStyle()
Dim frmStyle As Long
If hWndForm = 0 Then Exit Sub
frmStyle = GetWindowLong(hWndForm, GWL_STYLE)
If bCloseBtn Then
frmStyle = frmStyle Or WS_SYSMENU
Else
frmStyle = frmStyle And Not WS_SYSMENU
End If
SetWindowLong hWndForm, GWL_STYLE, frmStyle
DrawMenuBar hWndForm
End Sub
Private Sub optCloseOn_Click()
bCloseBtn = True
cmdBeenden.Cancel = True
SetUserFormStyle
End Sub
Private Sub optCloseOff_Click()
bCloseBtn = False
cmdBeenden.Cancel = False
SetUserFormStyle
End Sub
Sub ClearAll()
Dim C As Integer
On Error Resume Next
For C = 1 To 8
Me.Controls("ComboBox" & CStr(C)).Text = ""
Next C
For C = 1 To 20
Me.Controls("TextBox" & CStr(C)).Text = ""
Next C
Image2.Picture = LoadPicture("")
End Sub
Private Sub UserForm_Activate()
Dim lZeile As Long
Dim lCoBox As Long
With Worksheets("Alter")
With Me.ComboBox1
.ColumnCount = 3
.ColumnWidths = "1 cm; 1 cm; 1 cm"
For lZeile = 1 To Range("A65536").End(xlUp).Row
.AddItem " "
Hier hängt sich der Code bei der Initialisierung auf...
.List(lCoBox, 0) = Range("A" & lZeile).Value
.List(lCoBox, 1) = Range("B" & lZeile).Value
.List(lCoBox, 2) = Range("C" & lZeile).Value
lCoBox = lCoBox + 1
Next lZeile
End With
End With
End Sub
Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim iAlter As Integer
Dim iLiBo As Integer
If Me.TextBox4.Value "" Then
If IsDate(Me.TextBox4.Value) Then
If (Month(Date)
(Month(Date) = Month(CDate(TextBox4.Value))) And _
Day(CDate(TextBox4.Value)) > Day(Date) Then
iAlter = (Year(Date) - _
Year(CDate(TextBox4.Value))) - 1
Else
iAlter = Year(Date) - _
Year(CDate(TextBox4.Value))
End If
Me.TextBox21.Value = iAlter
If iAlter 99 Then Exit Sub
For iLiBo = 0 To Me.ComboBox1.ListCount
If iAlter >= Me.ComboBox1.List(iLiBo, 1) And _
iAlter
Me.ComboBox1.ListIndex = iLiBo
Exit For
End If
Next iLiBo
End If
End If
End Sub
Leider ist die Datei zu groß zum Hochladen. Ich hoffe, mir kann trotzdem jemand helfen...
Gruß Frank