AW: Listbox und Kalender
16.08.2016 20:48:58
Ben
hier habe ich was versucht aber ich bekomme nicht den wert aus der listbox dem mitarbeiter in der spalte zugeordnet.
Private WithEvents Calendar1 As cCalendar
Dim i As Byte, sor, sor2, sor3 As String
Private Sub Calendar1_Click()
On Error Resume Next
Dim ara As Range
Set ara = Sheets("data").Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Find(CDate( _
Calendar1.Value), , xlValues, xlWhole)
If Not ara Is Nothing Then
Sheets("data").Cells(ara.Row, 1).Select
TextBox5.Text = Sheets("data").Cells(ara.Row, 2).Value
For i = 6 To 19
Controls("TextBox" & i).Text = Sheets("data").Cells(ara.Row, i - 3).Value
Next
Else
MsgBox "The selected date not available."
End If
End Sub
Private Sub CommandButton1_Click()
Dim ara As Range
Set ara = Sheets("Aufträge").Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Find(CDate( _
Calendar1.Value), , xlValues, xlWhole)
If Not ara Is Nothing Then
Sheets("data").Cells(ara.Row, 2).Value = ListBox1.Text
For i = 6 To 18
Sheets("Data").Cells(ara.Row, i - 3).Value = Controls("ListBox1" & i).Text
Next
End If
End Sub
Private Sub CommandButton18_Click()
sor3 = MsgBox("Do you want to save the workbook?", vbYesNo)
If sor3 = vbNo Then
ActiveWorkbook.Close SaveChanges:=False
Else
ActiveWorkbook.Save
Application.Quit
End If
End Sub
Private Sub Kapat_Click()
Unload UserForm2
End Sub
Private Sub gir()
Dim ara As Range
Set ara = Sheets("Aufträge").Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Find(CDate( _
Calendar1.Value), , xlValues, xlWhole)
If Not ara Is Nothing Then
Sheets("ListBox1").Cells(ara.Row, 2).Value = ListBox1.Text
For i = 6 To 18
Sheets("data").Cells(ara.Row, i - 3).Value = Controls("ListBox" & i).Text
Next
End If
End Sub
Private Sub UserForm_Initialize()
With ListBox1
.ColumnCount = 4
.ColumnWidths = "3cm;7cm;3cm;3cm"
.ColumnHeads = True
ListBox1.RowSource = "Aufträge!A2:D9999"
Set Calendar1 = New cCalendar
Calendar1.Add_Calendar_into_Frame Me.Frame1
TextBox6.EnterKeyBehavior = True
For i = 5 To 18
Controls("TextBox" & i).EnterKeyBehavior = True
Controls("TextBox" & i).ScrollBars = fmScrollBarsBoth
Next
Calendar1_Click
End With
End Sub