Liste erweitern
14.02.2014 11:16:52
Erich
Hi,
so ganz klar ist mir die Aufgabe nicht, aber vielleicht... :-)
Probier mal
Option Explicit ' IMMER zu empfehlen
Private Sub UserForm_Initialize() ' Formular initialisieren
Dim a As Integer
'Dim bereich As Range
' Set bereich = Sheets("Tabelle1").Rows(13).Find("2008", LookAt:=xlWhole)
'If bereich Is Nothing Then
' MsgBox "JAhr nicht gefunden"
'Else
' MsgBox "Jahr in Spalte " & bereich & " gefunden"
'End If
'zeile = Worksheets("Buchungen").Cells(Rows.Count, 1).End(xlUp).Row + 1
'Dim bereich As Range
'Set bereich = Sheets("Set").Rows(2).Find("1", LookAt:=xlWhole)
'If bereich = 1 Then
'Sheets("Set").Rows(1).Copy Destination:=Sheets("Buchungen").Cells(2, zeile)
'End If
'Sheets("Buchungen").Rows (2)
'End If
OB_DoIt False, False ' Ausblenden der Felder
With Worksheets("Set")
'Listenfeld Artikel befüllen ohne Leerzeilen
For a = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(a, 1) "" Then LBox_Artikel.AddItem .Cells(a, 1)
Next a
'Listenfeld Set befüllen ohne Leerzeilen
For a = 2 To .Cells(1, .Columns.Count).End(xlToLeft).Column
If .Cells(1, a) "" Then LBox_Set.AddItem .Cells(1, a)
Next a
End With
With Worksheets("Besteller")
'Listenfeld Besteller befüllen ohne Leerzeilen
For a = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(a, 1) "" Then LBox_Besteller.AddItem .Cells(a, 1)
Next a
'Listenfeld Besteller2 befüllen ohne Leerzeilen
For a = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row
If .Cells(a, 2) "" Then LBox_Besteller2.AddItem .Cells(a, 2)
Next a
End With
Txt_Datum.Text = Format(Date, "dd.mm.yyyy") ' heutiges Datum einfügen
End Sub
Private Sub OB_Ausgang_Click() ' Optionsfeld Ausgang'
OB_DoIt False, True
End Sub
Private Sub OB_Eingang_Click() ' Optionsfeld Eingang'
OB_DoIt True, False
End Sub
Private Sub OB_DoIt(blnA As Boolean, blnB As Boolean)
' Gruppe An/Aus
Lb_Artikel.Visible = blnA ' Artikel
LBox_Artikel.Visible = blnA
Lb_Besteller2.Visible = blnA ' Einkäufer
LBox_Besteller2.Visible = blnA
' Gruppe Aus/An
Lb_Set.Visible = blnB ' Set
LBox_Set.Visible = blnB
Lb_Anzahl.Visible = blnB ' Anzahl
Txt_Anzahl.Visible = blnB
Lb_Datum.Visible = blnB ' Datum
Txt_Datum.Visible = blnB
Lb_Besteller.Visible = blnB ' AD-Besteller
LBox_Besteller.Visible = blnB
End Sub
Private Sub Cmd_Absenden_Click() ' auf Tabellenblatt übertragen
Dim wSet As Worksheet, myZeile As Long, tt As Long, cc As Long
Set wSet = Worksheets("Set")
With Worksheets("Buchungen")
' inhalt = .Cells(.Rows.Count, 1).End(xlUp).Value ' wozu?
myZeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(myZeile, 3) = CLng(Txt_Anzahl) ' sonst wird Text ausgegeben
.Cells(myZeile, 4) = CDate(Txt_Datum) ' sonst wird Text ausgegeben
If OB_Eingang Then
.Cells(myZeile, 1) = "Eingangsbuchung"
.Cells(myZeile, 2) = LBox_Artikel
.Cells(myZeile, 5) = LBox_Besteller2
ElseIf OB_Ausgang Then
.Cells(myZeile, 1) = "Ausgangsbuchung"
.Cells(myZeile, 2) = LBox_Set
.Cells(myZeile, 5) = LBox_Besteller
For cc = 2 To wSet.Cells(1, wSet.Columns.Count).End(xlToLeft).Column
If wSet.Cells(1, cc) = LBox_Set Then Exit For
Next cc
If wSet.Cells(1, cc) = LBox_Set Then
For tt = 2 To wSet.Cells(.Rows.Count, cc).End(xlUp).Row
If wSet.Cells(tt, cc) "" Then
.Cells(myZeile + 1, 1).Resize(, 5) = _
.Cells(myZeile, 1).Resize(, 5).Value
myZeile = myZeile + 1
.Cells(myZeile, 2) = wSet.Cells(tt, 1)
End If
Next tt
Else
Stop
End If
End If
End With
End Sub
Private Sub Cmd_Löschen_Click()
Txt_Anzahl.Value = ""
OB_Ausgang.Value = False
OB_Eingang.Value = False
' LBox_Artikel.Value = Disabled gips nich
' LBox_Set.Value = Disabled
' LBox_Besteller.Value = Disabled
' LBox_Besteller2.Value = Disabled
LBox_Artikel.Enabled = False
LBox_Set.Enabled = False
LBox_Besteller.Enabled = False
LBox_Besteller2.Enabled = False
End Sub
Private Sub Cmd_Schließen_Click() 'Formular schließen
Unload UF_Streuartikel
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich