Gruppe
Dialog
Problem
Wie kann ich per Dialog die Bestände von 2 Lägern führen?
ClassModule: frmLager
Private Sub cboArtikel_Change()
Dim wks As Worksheet
Dim iRow As Integer
If optLagerA.Value = True Then
Set wks = Worksheets("Lager1")
Else
Set wks = Worksheets("Lager2")
End If
If cboArtikel.ListIndex = -1 Then
txtStueck.Text = ""
Else
iRow = WorksheetFunction.Match( _
cboArtikel.Value, wks.Columns(1), 0)
txtStueck.Text = wks.Cells(iRow, 2).Value
End If
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
Dim wks As Worksheet
Dim iRow As Integer
If optLagerA.Value = True Then
Set wks = Worksheets("Lager1")
Else
Set wks = Worksheets("Lager2")
End If
If cboArtikel.ListIndex = -1 Then
iRow = wks.Cells(Rows.Count, 1).End(xlUp).Row + 1
Else
iRow = WorksheetFunction.Match( _
cboArtikel.Value, wks.Columns(1), 0)
End If
wks.Cells(iRow, 1).Value = cboArtikel.Value
If optEingang.Value = True Then
wks.Cells(iRow, 2).Value = _
wks.Cells(iRow, 2).Value + CDbl(txtStueck.Text)
Else
wks.Cells(iRow, 2).Value = _
wks.Cells(iRow, 2).Value - CDbl(txtStueck.Text)
End If
txtStueck.Text = wks.Cells(iRow, 2).Value
End Sub
Private Sub optLagerA_Change()
Call optLager_Change
End Sub
Private Sub optLagerB_Change()
Call optLager_Change
End Sub
Private Sub optLager_Change()
Dim wks As Worksheet
Dim iRow As Integer
cboArtikel.Clear
If optLagerA.Value = True Then
Set wks = Worksheets("Lager1")
Else
Set wks = Worksheets("Lager2")
End If
iRow = 2
With cboArtikel
Do Until IsEmpty(wks.Cells(iRow, 1))
.AddItem wks.Cells(iRow, 1).Value
iRow = iRow + 1
Loop
If .ListCount > 0 Then
.ListIndex = 0
End If
End With
End Sub
StandardModule: basMain
Sub CallForm()
If ActiveSheet.Name = "Lager1" Then
frmLager.optLagerA.Value = True
Else
frmLager.optLagerB.Value = True
End If
frmLager.Show
End Sub