AW: Userform hilfe
04.04.2018 11:29:51
Peter(silie)
Hallo,
hier deine Mappe: https://www.herber.de/bbs/user/120845.xlsm
Durchlaufe den Code Schrittweise mit dem Debugger.
Mehr Code gibts von mir nicht mehr.
Musst das ganze ja auch irgendwo verstehen und
anpassen sowie erweitern können.
Fragen beantworte ich natürlich gerne.
hier nur Code:
Option Explicit
Private Sub CmbKunde_Change()
Dim ws As Worksheet 'Tabelle mit Kunden und Tel-Nr
Dim lRow As Long 'letzte Zelle einer Spalte
Dim tmp As Variant 'zwischenspeichern v. Daten
'Falls kein Kunde ausgewählt beende hier
If CmbKunde.Value = vbNullString Then Exit Sub
Set ws = ThisWorkbook.Sheets("Daten für USERFORM")
With ws
'hole dir die letzte Zeile der Spalte A
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
'zwischenspeichern von allen kunden
'wird an GetPosition weitergegeben zum suchen
'des richtigen Kunden
'Arrays zu druchsuchen ist schneller als eine Range
'zu durchsuchen
tmp = .Range(.Cells(1, 1), .Cells(lRow, 1)).Value2
'Suche nach dem Kunden im Array
lRow = GetPosition(CmbKunde.Value, tmp)
'Falls gefunden
If lRow > 0 Then
'Füge die Tel-Nr in die Textbox ein
Me.TxtKundentelefon.Value = .Cells(lRow, 2).Value
End If
End With
End Sub
Private Sub Cmdabrechen_Click()
Unload Me 'Closes the form
End Sub
Private Sub CmdMaterial_Change()
Dim ws As Worksheet 'Tabelle mit userform daten
Dim pos As Long 'Position eines Materials
'Falls die Combo leer ist, dann setze checkboxes zurück und beende
If CmdMaterial.Value = vbNullString Then
ClearCheckboxes
Exit Sub
End If
Set ws = ThisWorkbook.Sheets("Daten für USERFORM")
With ws
'finde das Material
pos = GetPosition(CmdMaterial.Value, _
.Range(.Cells(1, 4), .Cells(10, 4)))
'Falls gefunden
If pos > 0 Then
'guckt ob die benötigte zelle nicht leer ist
'ist die zelle nicht leer dann ist die checkbox auf wahr gesetzt
Me.CheckBox1.Value = CBool(Not IsEmpty(.Cells(pos, 5)))
Me.CheckBox2.Value = CBool(Not IsEmpty(.Cells(pos, 6)))
Me.CheckBox3.Value = CBool(Not IsEmpty(.Cells(pos, 7)))
Me.CheckBox4.Value = CBool(Not IsEmpty(.Cells(pos, 8)))
Else
ClearCheckboxes
End If
End With
End Sub
'Setzt die werte der checkboxes zurück
Private Sub ClearCheckboxes()
Me.CheckBox1.Value = False
Me.CheckBox2.Value = False
Me.CheckBox3.Value = False
Me.CheckBox4.Value = False
Me.CheckBox5.Value = False
Me.CheckBox6.Value = False
Me.CheckBox7.Value = False
End Sub
Private Sub CmdSpeichern_Click()
Dim ws As Worksheet
Dim i As Long
On Error GoTo ClientSheetNotThere
Set ws = ThisWorkbook.Sheets(Me.CmbKunde.Value)
On Error Resume Next
'Sorry aber das ist keiner Beschreibung würdig...
'der Debugger lässt grüßen
With ws
i = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(i, 1).Value = Me.CmdMaterial.Value
If Me.CheckBox1.Value = True Then
.Cells(i, 2).Value = "x": End If
If Me.CheckBox2.Value = True Then
.Cells(i, 3).Value = "x": End If
If Me.CheckBox3.Value = True Then
.Cells(i, 4).Value = "x": End If
If Me.CheckBox4.Value = True Then
.Cells(i, 5).Value = "x": End If
.Cells(i, 6).Formula = "=WENN(G14="";"";G14)"
.Cells(i, 7).Value = CDate(Me.TxtDatum.Value)
.Cells(i, 8).Value = Me.TextBox1.Value
If Me.CheckBox5.Value = True Then
.Cells(i, 9).Value = "x": End If
If Me.CheckBox6.Value = True Then
.Cells(i, 10).Value = "x": End If
If Me.CheckBox7.Value = True Then
.Cells(i, 11).Value = "x": End If
.Cells(i, 12).Value = CDate(Me.TextBox2.Value)
End With
On Error GoTo 0
ClientSheetNotThere:
End Sub
Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'erlaubt . und 0-9
Select Case KeyAscii
Case 46, 48 To 57:
Case Else: KeyAscii = 0
End Select
End Sub
Private Sub TxtDatum_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'erlaubt . und 0-9
Select Case KeyAscii
Case 46, 48 To 57:
Case Else: KeyAscii = 0
End Select
End Sub
Private Sub UserForm_Initialize()
Dim ws As Worksheet 'Tabelle mit Kunden
Dim lRow As Long 'Letzte Zeile
'Aktuelles Datum
Me.TxtDatum.Value = Date
'Hole alle Kunden aus der Tabelle für die userform
'füge die Kunden in die Combo ein
Set ws = ThisWorkbook.Sheets("Daten für USERFORM")
With ws
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Me.CmbKunde.List = .Range(.Cells(2, 1), .Cells(lRow, 1)).Value2
lRow = .Cells(.Rows.Count, 4).End(xlUp).Row
'Füge die Materialliste ein
Me.CmdMaterial.List = .Range(.Cells(2, 4), .Cells(lRow, 4)).Value2
'zeige das erste Item der Artikel liste an
Me.CmdMaterial.Value = Me.CmdMaterial.List(0, 0)
End With
End Sub
'Gibt die Position eines Wertes in einem Array oder einer Range zurück
Private Function GetPosition(ByVal OfItem As String, _
ByRef Area As Variant) As Long
If Not VBA.IsError(Application.Match(OfItem, Area, 0)) Then
GetPosition = Application.Match(OfItem, Area, 0)
End If
End Function