Discussion :

[DavidMalbrancq]

bonjour le phorum

j'ai un userform qui charge une combobox avec les jours de la semaine depuis une BDD
je souhaiterai que celle ci ne soit alimentée que par les dates supérieures ou egales à la date du jour

sans pour autant créer une autre combobox, cela doit être transparent pour l'utilisateur

voici mon code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Private Sub UserForm_Initialize()
 
    'Liste Groupes
    Groupes = ActiveSheet.Name
    Worksheets(Groupes).Unprotect "planning"
    Set f = Sheets(Groupes)
    Set dico = CreateObject("Scripting.Dictionary")
 
    a = f.Range("E7:E" & f.[E65000].End(xlUp).Row)   ' tableau C(n,1) pour rapidité
 
        For i = LBound(a) To UBound(a)
         If a(i, 1) <> "" Then Mondico(a(i, 1)) = ""
        Next i
 
    temp = dico.keys
 
    '-avec tri (Fonction)
    Call Tri(temp, LBound(temp), UBound(temp))
 
    Me.cbx_jour_planifiée.List = temp

je n'arrive pas à voir ou je peux mettre dans cette boucle la condition sur la date >= au jour
ma colonne E contient les jours
ma colonne F contient les dates

merci d'avance pour vos pistes ou aide

david

[DavidMalbrancq]

bonjour le phorum

désolé de relancer mais une idée pourrait fortement m'aider....

merci d'avance

david

[Malick]

Bonjour,

une idée serait :

1. Ajout d'une comparaison avec la date actuelle ;
2. Suppression des valeurs antérieures à la date du jour.

Vous pouvez essayer avec ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Private Sub UserForm_Initialize()
 
    'Liste Groupes
    Groupes = ActiveSheet.Name
    Worksheets(Groupes).Unprotect "planning"
    Set f = Sheets(Groupes)
    Set dico = CreateObject("Scripting.Dictionary")
 
    ' Récupère la date du jour
    Dim today As Date
    today = Date
 
    ' Tableau des jours à partir de la colonne E (E7 et suivants)
    a = f.Range("E7:E" & f.[E65000].End(xlUp).Row) ' tableau C(n,1) pour rapidité
 
    ' On remplit le dictionnaire avec les jours >= à la date actuelle
    For i = LBound(a) To UBound(a)
        If a(i, 1) <> "" Then
            If IsDate(a(i, 1)) Then
                If CDate(a(i, 1)) >= today Then
                    dico(a(i, 1)) = ""
                End If
            End If
        End If
    Next i
 
    ' Récupération des jours filtrés dans un tableau temporaire créé à cet effet
    temp = dico.keys
 
    ' Tri des jours (appel de la fonction Tri)
    Call Tri(temp, LBound(temp), UBound(temp))
 
    ' On procède à l'alimentation de la ComboBox avec les jours filtrés
    Me.cbx_jour_planifiée.List = temp
 
End Sub

[DavidMalbrancq]

merci pour ton retour
mais en fait dans mon combobox
je n'ai pas de date mais un jour de semaine
la date se situe sur le seconde colonne
colonne E = jour
colonne F = date

je souhaiterai juste que les dates < au jour ne soit pas remontées

avec ta macro, je n'ai plus rien dans mon combobox

david

[Malick]

Ok, avec cette version modifiée, qu'est-ce que cela donne ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Private Sub UserForm_Initialize()
 
    ' Liste Groupes
    Groupes = ActiveSheet.Name
    Worksheets(Groupes).Unprotect "planning"
    Set f = Sheets(Groupes)
    Set dico = CreateObject("Scripting.Dictionary")
 
    ' Récupère la date du jour
    Dim today As Date
    today = Date
 
    ' Tableau des jours à partir des colonnes E (jours) et F (dates)
    jours = f.Range("E7:E" & f.[E65000].End(xlUp).Row) ' tableau des jours
    dates = f.Range("F7:F" & f.[F65000].End(xlUp).Row) ' tableau des dates
 
    ' On remplit le dictionnaire avec les jours correspondants aux dates >= aujourd'hui
    For i = LBound(jours) To UBound(jours)
        If dates(i, 1) <> "" Then
            If IsDate(dates(i, 1)) Then
                If CDate(dates(i, 1)) >= today Then
                    dico(jours(i, 1)) = ""
                End If
            End If
        End If
    Next i
 
    ' Récupération des jours filtrés dans un tableau temporaire créé à cet effet
    temp = dico.keys
 
    ' Tri des jours (appel de la fonction Tri)
    Call Tri(temp, LBound(temp), UBound(temp))
 
    ' On procède à l'alimentation de la ComboBox avec les jours filtrés
    Me.cbx_jour_planifiée.List = temp
 
End Sub

[DavidMalbrancq]

désolé

cela me remonte toujours les dates inférieurs à ce jour....

je t'ai mis un fichier pour voir si mes combobox en cascade ne pose pas problème
à ce stade seule la combobox 1 est alimentée

merci de ton aide

[Malick]

Le problème pourrait-être causé par la façons dont les données des colonnes E et F sont récupérées et de la façon de traiter les dates.

Une adaptation à tester pour voir.

J'espère que ce sera la bonne.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Private Sub UserForm_Initialize()
 
    ' Liste Groupes
    Groupes = ActiveSheet.Name
    Worksheets(Groupes).Unprotect "planning"
    Set f = Sheets(Groupes)
    Set dico = CreateObject("Scripting.Dictionary")
 
    ' Récupère la date du jour
    Dim today As Date
    today = Date
 
    ' Récupération des plages des jours et des dates sous forme de tableaux
    Dim jours As Variant, dates As Variant
    jours = f.Range("E7:E" & f.Cells(f.Rows.Count, "E").End(xlUp).Row).Value ' tableau des jours
    dates = f.Range("F7:F" & f.Cells(f.Rows.Count, "F").End(xlUp).Row).Value ' tableau des dates
 
    ' On remplit le dictionnaire avec les jours correspondants aux dates >= aujourd'hui
    Dim i As Long
    For i = LBound(jours, 1) To UBound(jours, 1)
        If dates(i, 1) <> "" Then
            If IsDate(dates(i, 1)) Then
                If CDate(dates(i, 1)) >= today Then
                    dico(jours(i, 1)) = ""
                End If
            End If
        End If
    Next i
 
    ' Récupération des jours filtrés dans un tableau temporaire créé à cet effet
    temp = dico.keys
 
    ' Tri des jours (appel de la fonction Tri)
    Call Tri(temp, LBound(temp), UBound(temp))
 
    ' On procède à l'alimentation de la ComboBox avec les jours filtrés
    Me.cbx_jour_planifiée.List = temp
 
End Sub

[DavidMalbrancq]

malheureusement toujours pas....

[Malick]

Difficile de tester, car il y a des liaisons apparemment.

Je constate également qu'au niveau de certains modules, les variables ne sont pas déclarées.

[DavidMalbrancq]

oui c'est mon problème, je ne déclare pas souvent les variables ni option explicit

pour les liaisons ce n'est pas le plus important
si je parviens à exclure les dates obsolète cela me va

[DavidMalbrancq]

bonjour j'ai finalement trouvé via une manière détourné ce que je souhaitais
avec le filtre des combobox j'ai ajouté dans l'affichage de ma listobox un filtre sur les date et une autre colonne que je voulais vide

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
 
Sub affiche_jour_creneaux_seance()
 
  Dim Tbl()
  Set F = Sheets(Groupes)
   BD = F.Range("A7:Q" & F.[A65000].End(xlUp).Row).Value
   Ncol = UBound(BD, 2)
 
    dte = Me.cbx_jour_planifiée
    creneaux = Me.cbx_creneaux_horaires
    seance = Me.cbx_seance
 
  n = 0
  For i = 1 To UBound(BD)
    If BD(i, 5) Like dte And BD(i, 7) Like creneaux And BD(i, 4) Like seance And BD(i, 6) >= CDate(Date) And IsEmpty(BD(i, 10)) Then
        n = n + 1: ReDim Preserve Tbl(1 To Ncol, 1 To n)
        For K = 1 To Ncol: Tbl(K, n) = BD(i, K): Next K
    End If
  Next i
  If n > 0 Then
     Me.lst_RDV.Column = Tbl
     Me.lbl_RDV_dispo.Caption = "Vous avez " & Me.lst_RDV.ListCount & " RDV disponible(s) pour ce jour/creneau/date"
     Me.lbl_RDV_dispo.BackColor = RGB(0, 255, 0)
  Else
     Me.lst_RDV.Clear
     Me.lbl_RDV_dispo.Caption = "il n'y a plus de RDV disponible, Veuillez modifier votre choix"
     Me.lbl_RDV_dispo.BackColor = RGB(255, 0, 0)
  End If
 
End Sub

merci encore pour tes propositions

david

[Malick]

Super