Combobox

[Arni49]

Hallo,

hier mein Userformcode mit der ich in einer Tabelle Suche.

abhängig der Spaltenauswahl kann über die CBO Auswahl Suchkriterium das Tabellenblatt durchsucht werden.

Zusätzlich habe ich noch Frames zu erweiterten Auswahl eingebaut die je nach Auswahl in der Spaltenauswahl aufpoppen.

jetzt zu meinem Problem:

Spaltenauswahl z.B Datum und Auswahl Suchkriterium 19.03.2019, dann über Spaltenauswahl z.B Schicht und über Frame z.B. Früh kommt der Fehler Laufzeitfehler 380.
Habe versucht vorher den Inhalt der CboAuswahl mit "" und Clear zu löschen funktioniert aber nicht?

Brauche mal wieder eure Hilfe.

Code:

Private Sub CBOAbbrechen_Click()
Unload Me
ESB.Show
End Sub
Private Sub cboAuswahl_Change()

If cboAuswahl = ChrW(63) Then
OpBInArbeit.Value = True

ElseIf cboAuswahl = ChrW(61) Then
OpBOffen.Value = True
ElseIf cboAuswahl = ChrW(60) Then
OpBErledigt.Value = True
ElseIf cboAuswahl = "Früh." Then
OpBFrüh.Value = True
ElseIf cboAuswahl = "Spät." Then
OpBSpät.Value = True
ElseIf cboAuswahl = "Nacht." Then
OpBNacht.Value = True
End If
Call cboSuchen_Click
End Sub
Private Sub cboAuswahl_DropButtonClick()
Dim lngColumn As Long
Dim Wert As Long
Dim i As Integer

If cboAuswAuswahl = "Standby" Then
If cboAuswahl = ChrW(63) Or cboAuswahl = ChrW(61) Or cboAuswahl = ChrW(60) Then
frmSchicht.Visible = False
fmStandby.Visible = True

Else
fmStandby.Visible = False
End If
End If


If cboAuswAuswahl = "Schicht" Then
If cboAuswahl = "Früh." Or cboAuswahl = "Spät." Or cboAuswahl = "Nacht." Then
fmStandby.Visible = False
frmSchicht.Visible = True

Else
frmSchicht.Visible = False
End If
End If

     
 If cboAuswAuswahl.Listindex > -1 Then
   With Sheets("Elektronisches Schichtbuch")
 
     lngColumn = Application.Match(cboAuswAuswahl, .Rows(3), 0) ' Spalte ermitteln mit dem Inhalt aus CboAuswahl
         
     cboAuswahl.List = .Range(.Cells(4, lngColumn), .Cells(Rows.Count, lngColumn). _
End(xlUp)).Value
   End With
   Wert = lngColumn
For i = 0 To cboAuswahl.ListCount - 1
   If cboAuswahl.List(i) = Wert Then Exit For
Next
If i = cboAuswahl.ListCount Then cboAuswahl.AddItem Wert
  End If
 OpBErledigt.Value = False
OpBInArbeit.Value = False
OpBOffen.Value = False

End Sub

Private Sub cboAuswAuswahl_Change()



If cboAuswAuswahl = "Standby" Then

cboAuswahl.Visible = False
LblAuswSuchkriterium.Visible = False
fmStandby.Visible = True
TboStandby.Visible = True
lblstandby.Visible = True
Image9.Visible = False
frmSchicht.Visible = False


ElseIf cboAuswAuswahl = "Schicht" Then



frmSchicht.Visible = True
cboAuswahl.Visible = False
LblAuswSuchkriterium.Visible = False
Image9.Visible = False
fmStandby.Visible = False

Else
fmStandby.Visible = False
TboStandby.Visible = False
lblstandby.Visible = False
LblAuswSuchkriterium.Visible = True
cboAuswahl.Visible = True
Image9.Visible = True


End If
End Sub
Private Sub cboESB_Click()
Unload Auswertung
ESB.Show
End Sub
Private Sub cboHelp_Click()
Sheets("Hilfe").Select
Unload Auswertung
ESB.Show
End Sub
Private Sub cboSuchen_Click()
Dim i As Long, k As Long, m As Long
Dim arr As Variant
Dim arrOut() As Variant
Dim blnGefunden As Boolean

If cboAuswahl.Value = "" Then Exit Sub


With Worksheets("Elektronisches Schichtbuch")


   arr = .Range(.Cells(3, 1), .Cells(.UsedRange.Rows.Count, 12)).Value  'Ergebnisse auflisten ab Zeile 4 (Cells (3, 1), ab 0-3 =4 Spalte 1


End With
'Auswertung.lboAuswert.Clear
Auswertung.lboAuswert.ColumnCount = UBound(arr, 2)
For i = 1 To UBound(arr)
   For k = 1 To UBound(arr, 2)
       If InStr(arr(i, k), cboAuswahl.Value) > 0 Then
           blnGefunden = True
           Exit For
       End If
   Next k
   If blnGefunden Then
       m = m + 1
       ReDim Preserve arrOut(1 To UBound(arr, 2), 1 To m)
       For k = 1 To UBound(arr, 2)
           arrOut(k, m) = arr(i, k)
       Next
       blnGefunden = False
   End If
Next i
If m <> 0 Then lboAuswert.Column = arrOut

End Sub

Private Sub CmdAdmin_Click()
Passwort.Show
Unload Me
End Sub

Private Sub CmdDrucken_Click()
Dim zeLB As Long, spLB As Long
Dim zeTB As Long, spTB As Long
Dim spab As Long, spac As Long
Dim agTB As Long, agLB As Long
    Dim allesDrucken As Boolean
   Range("Druckvorlage!A4:k65356") = ""  'Bereich in den die Ergebnis eingetragen werden
     
   '--- Drucker auswählen
   Application.Dialogs(xlDialogPrinterSetup).Show
   
   With ActiveSheet.PageSetup
   
   .LeftFooter = "&""Calibri""&10&BKassel Getriebebau DL382 H6 Welle &B" '& Chr(10)  & "&8Terminabsage nur in dringenden" & Chr(10) & "Fällen, spätestens jedoch " & Chr(10) & "24 Stunden vor der Behandlung." & Chr(10) & "Nicht rechtzeitig abgesagte Termine" & Chr(10) & "werden privat in Rechnung gestellt."
       
    .RightFooter = "&""Calibri""&10&BElektronisches Schichtbuch Abt4170&B" '& Chr(10) ' & "Um Behandlungspausen zu vermeiden" '& Chr(10) & "sowie Termin- und Therapeutenwünsche" & Chr(10) & "zu berücksichtigen, bitte Folgetermine" & Chr(10) & "8 Wochen im Voraus vereinbaren!" & Chr(10) & "&BMittagpause 12 - 14 Uhr&B"

   End With
   zeLB = 4
   '-- Prüfen, ob alles gedruckt werden muss
   For zeLB = 0 To lboAuswert.ListCount - 1
       allesDrucken = allesDrucken Or lboAuswert.Selected(zeLB)
Next
zeTB = 4
   spLB = 11
For zeLB = 0 To lboAuswert.ListCount - 1
       If lboAuswert.Selected(zeLB) Or Not allesDrucken Then

For spLB = 0 To lboAuswert.ColumnCount - 1  'Ab welcher Spalte aus der Suchergebnisliste soll gedruckt werden
               Sheets("Druckvorlage").Cells(zeTB, spLB + 1) = lboAuswert.List(zeLB, spLB) 'zeTB Zeile, spTB Spalte
       
           Next
    zeTB = zeTB + 1
   
           End If
           
  Next
   On Error Resume Next
Sheets("Druckvorlage").Visible = True
   ' Drucke Tabellenblatt
   Worksheets("Druckvorlage").PrintOut
  Sheets("Druckvorlage").Visible = True

End Sub

Private Sub CmdTeilSuche_Click()
Dim xSuche, xAdresse, xErste As String
Dim Y As Boolean
Dim arr() As Variant
Dim rng As Range
Dim iCounter, iRowU As Integer
Dim Suchart As Boolean

'If cboTeilergebnis.Value = True Then
   'Suchart = xlPart
'Else
   'Suchart = "xlWhole"
'End If
'TboSuchen.Clear
lboAuswert = ""
cboAuswAuswahl = ""
xSuche = TboSuchen
If xSuche = "" Then
   MsgBox "Bitte erst einen Suchbegriff eingeben!", vbExclamation, "Achtung!"
   Exit Sub
End If

       Set rng = Worksheets("Elektronisches Schichtbuch").Cells.Find _
           (xSuche, lookat:=xlPart, LookIn:=xlValues, SearchOrder:=xlByRows, Searchdirection:=xlNext)
       If Not rng Is Nothing Then
           With Worksheets("Elektronisches Schichtbuch")
               xErste = rng.Cells
               Y = True
               Do Until xAdresse = xErste
                   ReDim Preserve arr(0 To 12, 0 To iRowU)
                   'arr(0, iRowU) = .Name
                   'arr(1, iRowU) = rng.Cells
                   arr(0, iRowU) = .Cells(rng.Row, 1)
                   arr(1, iRowU) = .Cells(rng.Row, 2)
                   arr(2, iRowU) = .Cells(rng.Row, 3)
                   arr(3, iRowU) = .Cells(rng.Row, 4)
                   arr(4, iRowU) = .Cells(rng.Row, 5)
                   arr(5, iRowU) = .Cells(rng.Row, 6)
                   arr(6, iRowU) = .Cells(rng.Row, 7)
                   arr(7, iRowU) = .Cells(rng.Row, 8)
                   arr(8, iRowU) = .Cells(rng.Row, 9)
                   arr(9, iRowU) = .Cells(rng.Row, 10)
                   arr(10, iRowU) = .Cells(rng.Row, 11)
                   arr(11, iRowU) = .Cells(rng.Row, 12)
                   iRowU = iRowU + 1
                   Set rng = .Cells.FindNext(after:=rng)
                   xAdresse = rng.Cells
               Loop
               xAdresse = ""
               xErste = ""
           End With
       End If
'Next iCounter
If Y = False Then
   MsgBox "Der Suchbegriff wurde nicht gefunden!"
Else
   lboAuswert.Column = arr
End If
End Sub
Private Sub CmdEinträgeBea_Click()
Unload Auswertung
EintragBearbeiten.Show
End Sub
Private Sub cmdZeitReset_Click()
ActiveSheet.Cells(1, 1).Select
Sheets("Elektronisches Schichtbuch").Select
End Sub




Private Sub Image1_Click()
   ' Zellen leeren
   Dim zeLB As Long, spLB As Long
Dim zeTB As Long, spTB As Long
Dim spab As Long, spac As Long
Dim agTB As Long, agLB As Long
    Dim allesDrucken As Boolean
   Range("Druckvorlage!A4:k65356") = ""  'Bereich in den die Ergebnis eingetragen werden
     
   '--- Drucker auswählen
   Application.Dialogs(xlDialogPrinterSetup).Show
   
   With ActiveSheet.PageSetup
   
   .LeftFooter = "&""Calibri""&10&BKassel Getriebebau DL382 H6 Welle &B" '& Chr(10)  & "&8Terminabsage nur in dringenden" & Chr(10) & "Fällen, spätestens jedoch " & Chr(10) & "24 Stunden vor der Behandlung." & Chr(10) & "Nicht rechtzeitig abgesagte Termine" & Chr(10) & "werden privat in Rechnung gestellt."
       
    .RightFooter = "&""Calibri""&10&BElektronisches Schichtbuch Abt4170&B" '& Chr(10) ' & "Um Behandlungspausen zu vermeiden" '& Chr(10) & "sowie Termin- und Therapeutenwünsche" & Chr(10) & "zu berücksichtigen, bitte Folgetermine" & Chr(10) & "8 Wochen im Voraus vereinbaren!" & Chr(10) & "&BMittagpause 12 - 14 Uhr&B"

   End With
   zeLB = 4
   '-- Prüfen, ob alles gedruckt werden muss
   For zeLB = 0 To lboAuswert.ListCount - 1
       allesDrucken = allesDrucken Or lboAuswert.Selected(zeLB)
Next
zeTB = 4
   spLB = 11
For zeLB = 0 To lboAuswert.ListCount - 1
       If lboAuswert.Selected(zeLB) Or Not allesDrucken Then

For spLB = 0 To lboAuswert.ColumnCount - 1  'Ab welcher Spalte aus der Suchergebnisliste soll gedruckt werden
               Sheets("Druckvorlage").Cells(zeTB, spLB + 1) = lboAuswert.List(zeLB, spLB) 'zeTB Zeile, spTB Spalte
       
           Next
    zeTB = zeTB + 1
   
           End If
           
  Next
   On Error Resume Next
Sheets("Druckvorlage").Visible = True
   ' Drucke Tabellenblatt
   Worksheets("Druckvorlage").PrintOut
  Sheets("Druckvorlage").Visible = True

End Sub

Private Sub Image8_Click()
cboAuswAuswahl = ""
End Sub

Private Sub Image9_Click()
cboAuswahl = ""
End Sub




Private Sub LblAuswSuchkriterium_Click()

End Sub

Private Sub lboAuswert_Click()

End Sub

Private Sub OpBErledigt_Change()
OpBInArbeit.Value = False
OpBOffen.Value = False
If OpBErledigt = True Then
TboStandby = ChrW(60)
cboAuswahl = ChrW(60)
Else
TboStandby = ""
End If
End Sub

Private Sub OpBFrüh_Change()
cboAuswAuswahl = "Schicht"
cboAuswahl = ""
OpBSpät.Value = False
OpBNacht.Value = False
If OpBFrüh = True Then

cboAuswahl = "Früh."
End If
End Sub

Private Sub OpBInArbeit_Change()
OpBErledigt.Value = False
OpBOffen.Value = False
If OpBInArbeit = True Then
TboStandby = ChrW(63)
cboAuswahl = ChrW(63)
Else
TboStandby = ""
End If

End Sub

Private Sub OpBNacht_Change()
cboAuswAuswahl = "Schicht"
OpBFrüh.Value = False
OpBSpät.Value = False
If OpBNacht = True Then
cboAuswahl = "Nacht."
End If
End Sub

Private Sub OpBOffen_Change()
OpBErledigt.Value = False
OpBInArbeit.Value = False
If OpBOffen = True Then
TboStandby = ChrW(61)
cboAuswahl = ChrW(61)
Else
TboStandby = ""
End If

End Sub

Private Sub OpBSpät_Change()
cboAuswAuswahl = "Schicht"
OpBFrüh.Value = False
OpBNacht.Value = False
If OpBSpät = True Then

cboAuswahl = "Spät."
End If
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
       MsgBox "Nicht schließen über den (x) Button, Abbrechen benutzen"
       Cancel = True
End If
End Sub

Private Sub TboSuchen_Change()
cboAuswahl = ""
lboAuswert = ""
cboAuswAuswahl = ""
End Sub
Private Sub UserForm_Initialize()

fmStandby.Visible = False
frmSchicht.Visible = False
TboStandby.Visible = False
lblstandby.Visible = False
Image9.Visible = True

lboAuswert.ColumnCount = 12
lboAuswert.BoundColumn = 1
lboAuswert.ColumnWidths = "0,8cm;2,5cm;2,5cm;4cm;2,5cm;10cm;12cm;0,5cm;12cm;3cm;5cm"

Dim lngRechtesterEintrag As Long
Dim i As Integer
Dim eintrag As String
 
   'Hauptprojekt
lngRechtesterEintrag = Sheets("Elektronisches Schichtbuch").Cells(3, Columns.Count).End(xlToLeft).Column
   With Me.cboAuswAuswahl
       For i = 1 To lngRechtesterEintrag
           eintrag = Sheets("Elektronisches Schichtbuch").Cells(3, i).Value
           .AddItem CStr(eintrag)
       Next
   End With
End Sub

Gruß Arnold

[EbyAS]

Hallo,
und Du glaubst wirklich allen ernstes das wir das nachbauen?

[schauan]

Hallo,

hast Du die CboAuswahl eventuell mit einem Bereich vom Arbeitsblatt verknüpft? Dann dürfte Füllen nicht gehen

[Arni49]

Hallo,

hier mal  im Anhang die Datei mit der Userform Auswertung die über den Button suchen gestartet wird.


Spaltenauswahl z.B Datum und Auswahl Suchkriterium 19.03.2019, dann über Spaltenauswahl z.B Schicht und über Frame z.B. Früh kommt der Fehler Laufzeitfehler 380.

Habe versucht vorher den Inhalt der CboAuswahl mit "" und Clear zu löschen funktioniert aber nicht?


Gruß Arni

[schauan]

Hallo,

da kommt bei mir in der anderen Combo ".Früh" und nach Start der Suche "Der Suchbegriff wurde nicht gefunden"
Fehler 380 kommt erst, wenn oben wieder das Wort Datum gewählt wird und nochmal versucht wird, die Schicht zu wechseln. In dem Zusammenhang frag ich mich überhaupt, warum Du die Schicht sowohl mit den OptionButtons steuern willst als auch mit der Combo. Das ist doch doppelt gemoppelt und ich denke, erst dadurch kommt es zu dem Fehler.

Übrigens, was ist eigentlich der Zweck, wenn Du schon ein Datum rechts oben eingibst, dass Du es nochmal in der Combo zur Auswahl anbietest? Zudem es in Deinem Muster ein anderes ist und keinerlei Zusatzinformationen dabei stehen, sodass ich als unwissender Anwender nicht weiß, ob ich das erste oder dritte wählen soll oder welches auch immer?
Übrigens, warum soll man erst Datum wählen? Wenn ich das mache und anschließend das Datum eingebe, ist "Datum" wieder weg … Wenn ich so was programmiere, wo ein vom Anwender eingetragenes oder gewähltes Datum mal eine Rolle spielt oder nicht, hab ich maximal noch eine Checkbox zum Datum mit der Beschriftung "Datum verwenden"

Eventuell fällt die Bedienung auch leichter, wenn Du ein paar mehr Combos anlegst. Die dann vielleicht sogar als Filterauswahl über die jeweilige "Spalte" der Listbox setzen ...

[schauan]

Hallöchen,

noch mal was zur Usability usw.

Wenn Du einen Dialog programmierst, solltest Du Dich immer fragen, wie ein Anwender den möglichst intuitiv und vielleicht sogar ohne tiefgreifende Prozesskenntnisse ausfüllen kann. Wenn Du den selber ausprobierst, solltest Du bei jedem Klick überlegen, ob Du das Objekt sofort richtig genommen hast, weil Du den Ablauf in Deinem Dialog kennst oder ob man das auch intuitiv so tun kann.

Da kann man z.B. Auswahlfelder in Reihe oder untereinander platzieren und das jeweils nächste bis zur Eingabe ins vorherige disablen. Disablen hat manchmal den Vorteil gegenüber unvisible, dass der Anwender schon einen Überblick über den Eingabeprozess hat. Zu viele Felder auf einem Dialogblatt könnten aber auch schon wieder unübersichtlich werden, da muss man sich was anderes einfallen lassen. ..

Mehrfach genutzte Combos an gleicher Stelle sind auch eventuell problematisch. Als intuitiver Anwender komme ich nach der Datumseingabe oben rechts erst mal ins grübeln, ob ich was falsch gemacht habe, weil meine Eingabe plötzlich weg ist. Wobei, dass die Eingabe des Datums so weit von der Combo weg ist, hat mir auch nicht gefallen.

Ich komm auch intuitiv ins grübeln, wenn ich nicht weiß, welche von meinen Angaben für die Filterung genutzt werden. Ich hab's ja schon mit dem Datum geschrieben. Warum soll ich das erst in der Combo wählen, ich kann es doch gleich oben rechts eintragen. (Kann sein, dass die Frage dadurch kommt, dass das gewählte Datum nicht angezeigt wird)

Die Filter scheinen sich der Reihe nach auf die Anzeige der Listbox zu beziehen. Mit jeder Einstellung wird die Liste kürzer, weil es nicht mehr um die Originaldaten geht. Richtig? Damit klären sich zwar einige Fragen, aber kommt damit jeder user gleich zurecht? Würde mich als Anwender freuen, wenn ich da irgendwo sehe, was ich eingestellt hatte …

[Arni49]

Hallo,

habe es jetzt so gelöst, mehr bekomme ich Momentan nicht gebacken  .

Vielleicht kann mir jemand sagen wie ich per Kalenderauswahl, evtl mit Optionsbutton Datum einen Kalender aktivieren, eine Tag zum suchen auswählen kann.


Office 2016

Gruß