Office: (Office 2016) Listenfeld VBA-Code

André.H · 5. Januar 2019

Hallo, nun habe ich das Problem, das das Jahr und entsprechend der Monat nicht richtig sortiert, gefiltert wird.
Wenn ich zum 2019 auswähle, und dann die KW 1 wähle wird dann auch diese von 2018 ausgewählt. was ja nicht der Sinn der Sache ist. Auch die komplexe Auswahl funktioniert nicht so, wie man es möchte.
Der Code der Felder:
Code:

Private Sub lstKW_Click()
'Dim strFilter As String
'Dim varItem As Variant

strFilter = ""
With Me.lstKW
For Each varItem In .ItemsSelected
strFilter = strFilter & ", " & .ItemData(varItem)
Debug.Print strFilter 'Ausgabe zur Kontrolle
Next varItem
End With
Debug.Print strFilter
If Len(strFilter) > 2 Then
strFilter = Mid(strFilter, 2) 'erstes Komma wegschneiden
Me.Filter = "JK IN(" & strFilter & ")"
Me.FilterOn = True
End If

sSQL = " SELECT zei_datum " _
& " FROM qurZeitProjekt " _
& " WHERE JK In(" & strFilter & ")" _
& " GROUP BY zei_datum " _
& " ORDER BY zei_datum"
Me.lstTagAuswahl.RowSource = sSQL

End Sub

Private Sub lstMitarbeiter_Click()
Dim i As Long
Dim strFilter As String
Dim varItem As Variant
'strFilter = ""
With Me.lstMitarbeiter
For Each varItem In .ItemsSelected
strFilter = strFilter & ", " & .ItemData(varItem)
Next varItem
End With

If Len(strFilter) > 2 Then
Debug.Print strFilter 'Ausgabe zur Kontrolle
strFilter = Mid(strFilter, 3) 'erstes Komma wegschneiden
Me.Filter = "mit_id_f IN(" & strFilter & ")"
Me.FilterOn = True
Me.Form.Refresh
End If

End Sub

Private Sub lstMonat_Click()
Dim i As Long
Dim strFilter As String
Dim varItem As Variant

With Me.lstMonat
For Each varItem In .ItemsSelected
strFilter = strFilter & ", " & .ItemData(varItem)
Next varItem
End With

If Len(strFilter) > 2 Then
Debug.Print strFilter 'Ausgabe zur Kontrolle
strFilter = Mid(strFilter, 2) 'erstes Komma wegschneiden
Me.Filter = "zei_DMonat IN(" & strFilter & ")"
Me.Filter = "zei_DJahr IN(" & strFilter & ")"
Me.FilterOn = True
End If
End Sub

Private Sub lstTagAuswahl_AfterUpdate()
strFilter = ""
'Dim strFilter As String
'Dim varItem As Variant
With Me.lstTagAuswahl
For Each varItem In .ItemsSelected
strFilter = strFilter & ", " _
& Format(CDate(.ItemData(varItem)), "#yyyy-mm-dd#")
Next varItem
End With
If Len(strFilter) > 2 Then
strFilter = Mid(strFilter, 3) 'erstes Komma wegschneiden
Debug.Print strFilter 'Ausgabe zur Kontrolle
Me.Filter = "zei_datum In(" & strFilter & ")"
Me.FilterOn = True
End If

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wie kann man es am besten lösen?
Danke für eure unterstützung

Kyron9000 · 5. Januar 2019

...gefiltert oder sortiert?
Denke, du meinst gefiltert...
Habe das lstMonat eingebaut und im Code fehlt das Jahr für das Filter
Dein Code filtert nur Monat...!
Code dazu...
Code:

Me.Filter = "zei_DMonat IN(" & strFilter & ")" _
& " AND zei_DJahr =" & Me.cboJahr
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Kyron9000 · 5. Januar 2019

...habe die DB kurz mal überarbeitet, da war schon so viel Unsinn drin, das sich
bald keiner mehr auskennt. Wenn man das nicht rechtzeitig durchführt, bleibt das ewig dabei.
Außerdem habe ich für die 3 Listfelder nur eine Abfrage erstellt!
Falls ich etwas übersehen habe merkst du das ja sowieso, denke aber nicht.

PS: wieso hast eigentlich 2 Threads, geht ja eigentlich immer um die selbe Sache!?

André.H · 5. Januar 2019

Hallo Kyron,
nein, das sind zwei verschiedene Dinge. Daher habe ich es getrennt.
Habe daher zwar dieselbe DB-Basis genommen.
Im Grunde genommen geht es im gesamten um das selbe Projekt, nur die Inhalte sind da unterschiedlich.
Danke!
Ich schaue es mir an was ich da selber verkehrt gemacht habe.

André.H · 5. Januar 2019

Hallo Kyron, ja wenn ich das Jahr 2019 auswähle, und anschließend die KW 1 auswähle, wird das Datum vom Dez 2018 angezeigt. Im Prinzip richtig, das es ja die erste KW-Woche des Jahres 2019 ist. Das ist ja nicht so gewollt.
Ich weiß es nicht ob es so machbar ist:
In der Regel wähle ich das Jahr aus, dann entsprechend Monat(e), dann KW-Woche(n), dann Tag(e). Dann sollte die Möglichkeit bestehen, entsprechend den Mitarbeiter und /oder Projekt gefiltert werden. Letzt beides ist in dem Beispiel nicht enthalten.
Werde das Beispiel um diese Listenfelder ergänzen.
Ich weiß das es eine ziemliche komplexe Geschichte ist

Lanz Rudolf · 5. Januar 2019

Hallo
(KW 1 2019) geht vom Montag 31.12.2018 bis So 06.01.2019 !

in Meiner Doc s. Fusszeile unten rechts
Fiktion : Public Function fctKWMon(..)
Seite 313
11.13.37.37 Montag einer Kalenderwoche
Beispiel Resultat:
?fctKWMon(52,2012) --> gibt  24.12.2012
?fctKWMon(53,2012) --> gibt 31.12.2012
?fctKWMon(01,2013) --> gibt 31.12.2012

oder

?fctKWMon(1,2019) --> gibt 31.12.2018
?fctKWMon(53,2018) --> gibt 31.12.2018

Kyron9000 · 5. Januar 2019

...

KW-Woche des Jahres 2019 ist. Das ist ja nicht so gewollt.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Also, dafür würde ich jetzt gerne den Sinn erfahren!
Es gibt eben in KW 1 oft ein Datum vom Vorjahr, das ist eben so.
Wenn du es falsch haben möchtest, darfst nicht fnISOWeekYear verwenden.
Die Funktion ist extra dafür gemacht, dass es richtig funktioniert.
Verwende eben den nachstehenden Code für KW, musst aber alles für KW-List usw. umbauen!
Code:

Format([zei_datum],"ww",2) AS KWFalsch
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich erstelle es jedenfalls so nicht.

André.H · 5. Januar 2019

Hallo Kyron,
wenn das mit der KW allgemein so ist. Dann lasse ich es so. Für mich ging es darum das die Tage ja aus dem Vorjahr kommen und im ausgewählten Jahr "nichts verloren" haben.
Habe in der Anlage die DB mit den zwei weiteren Listenfelder (listProjekt und listMitarbeiter) angehängt. Wie ich es im vorigen Thread geschrieben habe sollten diese, je nach Auswahl die Datensätze gefiltert werden.
Danke für die Erklärung der KW, war mir so nicht bekannt.

Kyron9000 · 7. Januar 2019

...wird wohl nichts mehr kommen.
Habe es mir noch einmal angesehen und etwas erweitert.
Die nächste Erweiterung gehört aber dir selber *wink.gif*
Kann auch leicht sein, das ich etwas übersehen habe...
dann nachdenken und eine fertige DB zeigen *grins

André.H · 7. Januar 2019

Hallo Kyron,
erstmal sage ich danke für deine Bemühungen und Unterstützung.
Leider bin ich kein Acces-Profi wie ihr es seid.
Auch wenn ich einige Bücher über Acces, VBA,.. lese ist es nicht leicht das in einem Projekt zu übertragen.
Ich schaue mir die DB an :-)
Danke!

André.H · 7. Januar 2019

Hallo Kyron,
das sieht gut aus. Schaue mir das genauer an, so das ich Ergänzung, Änderung selbst vornehmen kann.
Wenn das Projekt fertig ist, kann ich gerne es dir zukommen lassen.

Kyron9000 · 7. Januar 2019

...mit viel Übung wird das schon, keine Angst...
immer dran bleiben und nie aufgeben!!
Fehler suchen, analysieren und dann... natürlich beheben *Smilie

Ergänzung, Änderung selbst vornehmen kann.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

PS: das ist sehr schlau..., denn nur so lernt man etwas dazu!

André.H · 7. Januar 2019

Hallo Alfred,
ja habe das ganze nun mal in das richtige Projekt übernommen.
Soweit alles gut. Nur wenn ich die KW die Woche auswähle, werden die entsprechenden Tage nicht ausgewählt. Das gleiche ist wenn ich den Monat auswähle, das die entsprechende KW und zugleich die Tage nicht in der Listbox angezeigt wird.
Habe den Code mal angehängt:
Code:

Option Compare Database
Option Explicit

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim sSQL As String
Dim strFilter As String
Dim varItem As Variant
Dim strFilter1 As String
Dim strFilter2 As String
Dim strFilter3 As String
Dim strFilter4 As String
Dim strFilter5 As String

Private Sub setListFalse(lst As Integer)
On Error GoTo ErrHandler
strFilter = ""
Select Case lst
Case 1 ' Tag
For Each varItem In Me.lstKW.ItemsSelected
Me.lstKW.Selected(varItem) = False
Next varItem
For Each varItem In Me.lstMonat.ItemsSelected
Me.lstMonat.Selected(varItem) = False
Next varItem
strFilter2 = ""
strFilter3 = ""
Case 2 'KW
For Each varItem In Me.lstTag.ItemsSelected
Me.lstTag.Selected(varItem) = False
Next varItem
For Each varItem In Me.lstMonat.ItemsSelected
Me.lstMonat.Selected(varItem) = False
Next varItem
strFilter1 = ""
strFilter3 = ""
Case 3 'Monat
For Each varItem In Me.lstTag.ItemsSelected
Me.lstTag.Selected(varItem) = False
Next varItem
For Each varItem In Me.lstKW.ItemsSelected
Me.lstKW.Selected(varItem) = False
Next varItem
strFilter1 = ""
strFilter2 = ""
End Select
If Me.chkFilterAll = False Then
Select Case lst
Case 4 'Projekt
For Each varItem In Me.lstAuftrag.ItemsSelected
Me.lstAuftrag.Selected(varItem) = False
Next varItem
Case 5 'Mitarbeiter
For Each varItem In Me.lstMitarbeiter.ItemsSelected
Me.lstMitarbeiter.Selected(varItem) = False
Next varItem
End Select
End If
ErrHandlerExit:
Exit Sub
ErrHandler:
MsgBox Err.Number & " " & Err.Description
Resume ErrHandlerExit
End Sub

Private Sub btnFilterOff_Click()
setListFalse 1
setListFalse 2
setListFalse 3
setListFalse 4
setListFalse 5
sSQL = " SELECT zei_datum" _
& " FROM qurTagKWMonatJahr " _
& " GROUP BY zei_datum " _
& " ORDER BY zei_datum"
Me.lstTag.RowSource = sSQL
Form_Load

End Sub

Private Function fncFilterAll() As String
Debug.Print "Filter1: ", strFilter1
Debug.Print "Filter2: ", strFilter2
Debug.Print "Filter3: ", strFilter3
Debug.Print "Filter4: ", strFilter4
Debug.Print "Filter5: ", strFilter5

strFilter = ""
If strFilter1 "" Then
strFilter = strFilter1
End If
If strFilter2 "" Then
If strFilter "" Then strFilter = strFilter & " AND "
strFilter = strFilter & strFilter2
End If
If strFilter3 "" Then
If strFilter "" Then strFilter = strFilter & " AND "
strFilter = strFilter & strFilter3
End If
If strFilter4 "" Then
If strFilter "" Then strFilter = strFilter & " AND "
strFilter = strFilter & strFilter4
End If
If strFilter5 "" Then
If strFilter "" Then strFilter = strFilter & " AND "
strFilter = strFilter & strFilter5
End If
fncFilterAll = strFilter
Debug.Print strFilter
End Function

Private Sub cboJahr_AfterUpdate()
Form_Load
Me.lstKW.Requery
Me.lstMonat.Requery
Me.lstTag.Requery
End Sub

Private Sub chkFilterAll_AfterUpdate()
If Me.chkFilterAll Then
Else
strFilter4 = ""
strFilter5 = ""
End If

End Sub

Private Sub Form_Load()
Me.Filter = "zei_DJahr =" & Me.cboJahr
Me.FilterOn = True
Me.chkFilterAll = False
End Sub

Private Sub lstAuftrag_Click()

On Error GoTo ErrHandler
setListFalse 5
strFilter = ""
With Me.lstAuftrag
For Each varItem In .ItemsSelected
strFilter = strFilter & ", " & .ItemData(varItem)
Next varItem
End With

If Len(strFilter) > 2 Then
strFilter = Mid(strFilter, 3) 'erstes Komma wegschneiden
strFilter = " auf_id_f IN(" & strFilter & ")"
strFilter4 = strFilter
If Me.chkFilterAll Then
strFilter = fncFilterAll
End If
Me.Filter = strFilter
Me.FilterOn = True
End If

ErrHandlerExit:
Exit Sub
ErrHandler:
MsgBox Err.Number & " " & Err.Description
Resume ErrHandlerExit
End Sub

Private Sub lstKW_Click()
On Error GoTo ErrHandler
setListFalse 2
With Me.lstKW
For Each varItem In .ItemsSelected
strFilter = strFilter & ", " & .ItemData(varItem)
Next varItem
End With
If Len(strFilter) > 2 Then
strFilter = Mid(strFilter, 3) 'erstes Komma wegschneiden
strFilter = "JK In(" & strFilter & ")"
strFilter2 = strFilter
If Me.chkFilterAll Then
strFilter = fncFilterAll
End If
Me.Filter = strFilter
Me.FilterOn = True
End If
sSQL = " SELECT zei_datum " _
& " FROM qurTagKWMonatJahr " _
& " WHERE JK In(" & strFilter & ")" _
& " GROUP BY zei_datum " _
& " ORDER BY zei_datum"
Me.lstTag.RowSource = sSQL
ErrHandlerExit:
Exit Sub
ErrHandler:
MsgBox Err.Number & " " & Err.Description
Resume ErrHandlerExit
End Sub

Private Sub lstMitarbeiter_Click()
On Error GoTo ErrHandler
setListFalse 4
With Me.lstMitarbeiter
For Each varItem In .ItemsSelected
strFilter = strFilter & ", " & .ItemData(varItem)
Next varItem
End With

If Len(strFilter) > 2 Then
strFilter = Mid(strFilter, 3) 'erstes Komma wegschneiden
strFilter = " mit_id_f IN(" & strFilter & ")"
strFilter5 = strFilter
If Me.chkFilterAll Then
strFilter = fncFilterAll
End If
Me.Filter = strFilter
Me.FilterOn = True
End If

ErrHandlerExit:
Exit Sub
ErrHandler:
MsgBox Err.Number & " " & Err.Description
Resume ErrHandlerExit
End Sub

Private Sub lstMonat_Click()
On Error GoTo ErrHandler
setListFalse 3
With Me.lstMonat
For Each varItem In .ItemsSelected
strFilter = strFilter & ", " & .ItemData(varItem)
Next varItem
End With
If Len(strFilter) > 2 Then
strFilter = Mid(strFilter, 3) 'erstes Komma wegschneiden
strFilter = "zei_DMonat IN(" & strFilter & ")" _
& " AND zei_DJahr =" & Me.cboJahr
strFilter3 = strFilter
If Me.chkFilterAll Then
strFilter = fncFilterAll
End If
Me.Filter = strFilter
Me.FilterOn = True
End If

ErrHandlerExit:
Exit Sub
ErrHandler:
MsgBox Err.Number & " " & Err.Description
Resume ErrHandlerExit
End Sub

Private Sub lstTag_AfterUpdate()
On Error GoTo ErrHandler
setListFalse 1
With Me.lstTag
For Each varItem In .ItemsSelected
strFilter = strFilter & ", " _
& Format(CDate(.ItemData(varItem)), "#yyyy-mm-dd#")
Next varItem
End With
If Len(strFilter) > 2 Then
strFilter = Mid(strFilter, 3) 'erstes Komma wegschneiden
strFilter = " zei_datum In(" & strFilter & ")"
strFilter1 = strFilter
If Me.chkFilterAll Then
strFilter = fncFilterAll
End If
Me.Filter = strFilter
Me.FilterOn = True
End If

ErrHandlerExit:
Exit Sub
ErrHandler:
MsgBox Err.Number & " " & Err.Description
Resume ErrHandlerExit
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Vielleicht kann man es so sehen wo da nun der Haken ist. Ich bin mir da nicht sicher.

Office: (Office 2016) Listenfeld VBA-Code

Listenfeld VBA-Code

Listenfeld VBA-Code

Listenfeld VBA-Code

Listenfeld VBA-Code

Listenfeld VBA-Code

Listenfeld VBA-Code - Similar Threads - Listenfeld VBA Code

Listenfeld in Word 2016

Formular mit Bedingung öffnen aus einem Listenfeld heraus (VBA)

Listenfeld wird nicht immer gefüllt

Listenfeld mit VBA auslesen und Textfeld befüllen

Listenfeld: Spalten-Update per VBA Laufzeitfehler 424

Zeile im Listenfeld per VBA auswählen

Listenfeld nach Änderung aktualisieren (VBA)