AW: Formatierung
22.05.2008 20:05:00
DieterB
Hi Herbert
Anbei der Code für mein Vorhaben, vielleich kannst Du deine Frage hiermit beantworten und mir eine Hilfestellung leisten:
Option Explicit
Private Sub UserForm_Initialize()
Dim i As Integer
For i = 4 To 869 Step 24
cboWahl.AddItem Range("Tabelle1!A" & i)
Next
Dim wks As Worksheet
Dim iRow As Integer
Set wks = Worksheets("Waren")
iRow = wks.Cells(Rows.Count, 1).End(xlUp).Row
With cboSuchen
'.RowSource = wks.Name & "!B4:I" & iRow
.ColumnWidths = "14;150;230;50;0;0;0"
End With
lstKorb.ColumnWidths = "14;150;150;60;60;60;60;"
txt1.Text = Range("G1") 'Datum
End Sub
'
Private Sub cboSuchen_Change()
' Dim rng As Range
' Dim dValue As String
' Dim iCounter As Integer
' dValue = CStr(cboSuchen.Value)
' Set rng = Columns("A").Find(dValue, _
' lookat:=xlWhole, LookIn:=xlValues)
'End Sub
Private Sub cboWahl_Click()
Dim a As Integer
cboSuchen.Clear
Select Case cboWahl.ListIndex
Case 0 '1 Verdichter
cboSuchen.List = Range("Waren!A3:G13").Value
Case 1 '2 Verdichter
cboSuchen.List = Range("Waren!A27:G37").Value
Case 2 '3 Verdichter
cboSuchen.List = Range("Waren!A51:G61").Value
Case 3 '4 Verdichter
cboSuchen.List = Range("Waren!A75:G85").Value
Case 4 'Saugsammelstück 2 Verd.
cboSuchen.List = Range("Waren!A99:G111").Value
Case 5 'Saugsammelstück 3 Verd.
cboSuchen.List = Range("Waren!A123:G135").Value
Case 6 'Saugsammelstück 4 Verd.
cboSuchen.List = Range("Waren!A147:G159").Value
Case 7 'Ölstandregulierung
cboSuchen.List = Range("Waren!A171:G181").Value
Case 8 'Ölsammelgefäß
cboSuchen.List = Range("Waren!A195:G205").Value
Case 9 'Ölfilter
cboSuchen.List = Range("Waren!A219:G221").Value
Case 10 'Ölabscheider
cboSuchen.List = Range("Waren!A243:G256").Value
Case 11 'Sammler stehend
cboSuchen.List = Range("Waren!A267:G290").Value
Case 12 'Sammler liegend
cboSuchen.List = Range("Waren!A291:G302").Value
Case 13 'Sammlerrahmen
cboSuchen.List = Range("Waren!A315:G317").Value
Case 14 'Sammlerstation m.Trockner
cboSuchen.List = Range("Waren!A339:G354").Value
Case 15 'ESA
cboSuchen.List = Range("Waren!A363:G368").Value
Case 16 'Drucktransmitter
cboSuchen.List = Range("Waren!A387:G390").Value
Case 17 'Bündelrohrverflüssiger
cboSuchen.List = Range("Waren!A411:G425").Value
Case 18 'Manometertafel
cboSuchen.List = Range("Waren!A435:G445").Value
Case 19 'Flüssigkeitsabscheider
cboSuchen.List = Range("Waren!A459:G469").Value
Case 20 'Filtertrockner WSG
cboSuchen.List = Range("Waren!A483:G494").Value
Case 21 'Filtertrockner WEU
cboSuchen.List = Range("Waren!A507:G518").Value
Case 22 'Blocktrockner
cboSuchen.List = Range("Waren!A531:G550").Value
Case 23 'Saugleitungsfilter
cboSuchen.List = Range("Waren!A555:G567").Value
Case 24 'Geräuschdämpfer
cboSuchen.List = Range("Waren!A579:G586").Value
Case 25 'Wärmerückgewinnung
cboSuchen.List = Range("Waren!A603:G613").Value
Case 26 'Anbau Plattentauscher
cboSuchen.List = Range("Waren!A627:G630").Value
Case 27 'Drehzahlregler
cboSuchen.List = Range("Waren!A651:G672").Value
Case 28 'Druckschalter
cboSuchen.List = Range("Waren!A675:G681").Value
Case 29 'Sicherheitsventil
cboSuchen.List = Range("Waren!A699:G705").Value
Case 30 'Rückschlagventil
cboSuchen.List = Range("Waren!A723:G737").Value
Case 31 'Zusatzlüfter
cboSuchen.List = Range("Waren!A747:G753").Value
Case 32 'Kugelventil ohne
cboSuchen.List = Range("Waren!A771:G785").Value
Case 33 'Kugelventil mit
cboSuchen.List = Range("Waren!A795:G805").Value
Case 34 'Anlaufentlastung
cboSuchen.List = Range("Waren!A819:G822").Value
Case 35 'Leistungsregler
cboSuchen.List = Range("Waren!A843:G845").Value
Case 36 'Rahmen
cboSuchen.List = Range("Waren!A867:G871").Value
End Select
cboSuchen.ListIndex = 0
End Sub
'
Private Sub UserForm_QueryClose _
' (Cancel As Integer, CloseMode As Integer)
' If CloseMode 1 Then Cancel = 1
'End Sub
Private Sub cboSuchen_Click()
Dim iCounter As Integer
If cboSuchen.Column(iCounter, cboSuchen.ListIndex) = "" Then Exit Sub
lstKorb.AddItem
For iCounter = 0 To 7
If iCounter
Private Sub cmdEintragen_Click()
Dim iRow As Integer, iRowL As Integer, iCol As Integer
iRowL = Cells(Rows.Count, 1).End(xlUp).Row + 1
For iRow = 0 To lstKorb.ListCount - 1
For iCol = 0 To 7
Cells(iRowL + iRow, iCol + 1) = lstKorb.List(iRow, iCol)
Next iCol
Next iRow
lstKorb.Clear
Columns.AutoFit
With Worksheets("Umsatz")
.Range("C1").Value = txtKunde.Text 'Kunde
.Range("C2").Value = txtNummer.Text 'Angebotsnummer
'.PrintOut copies:=1
End With
End Sub
Private Sub lstKorb_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If lstKorb.ListCount > 0 Then
lstKorb.RemoveItem lstKorb.ListIndex
End If
End Sub
Private Sub cmdEnde_Click()
' Application.DisplayAlerts = False
' ''Workbooks.Close
' Application.Quit
' Application.DisplayAlerts = True
Unload Me
End Sub