Microsoft 365 filtre sur un tabstrip depuis un combobox

troki74

XLDnaute Nouveau
Bonjour,
Je souhaite faire un filtre sur un tabstrip depuis un combobox voir deux (en cascade) mais si c'est déjà un ce serait super.
J'arrive à filtrer sur le nombre de tabs, mais impossible de renommer les tabs et encore moins de modifier les éléments des pages tabs
Voici mon code :
VB:
Private Sub FiltreAxe_Change()
 
 
Me.TabStrip1.Value = -1                                        'tabstrip no index start
    Do While TabStrip1.Tabs.Count > 1
        TabStrip1.Tabs.Remove (1)                           'remove all but first tab
    Loop
 
For i = 0 To Cells(Rows.Count, 1).End(xlUp).Row - 1 'boucle 1  = boucle sur tous les projets de la liste
If Sheets("Liste projet").Cells(i + 1, 2).Value = FiltreAxe Then
With GestionProjet.TabStrip1
              .Tabs.Add
              .Tabs(i).Caption = Sheets("Liste projet").Cells(i + 1, 4).Value
End With
Axestrat = Sheets("Liste projet").Cells(i + 1, 2).Value
Thème = Sheets("Liste projet").Cells(i + 1, 3).Value
NomRéduit = Sheets("Liste projet").Cells(i + 1, 5).Value
Réferent = Sheets("Liste projet").Cells(i + 1, 6).Value
Datedébutprojet = Sheets("Liste projet").Cells(i + 1, 9).Value
Datefinprojet = Sheets("Liste projet").Cells(i + 1, 10).Value
End If
Next i
 
End Sub
Le début c'est pour effacer les tabs, car on est pas obligé de passer par les filtres, donc lors de l'initialize toute la bdd est affichées.
J'ai donc un bug sur le caption (ligne 13), et les données des contrôles ne se modifie pas lors du changement de tabs (ligne 15 à 20), on a à chaque fois la première valeur issue du filtre.
Sauriez-vous me conseiller?
Cordialement.
 

Pièces jointes

  • TableauSubvention.xlsm
    41 KB · Affichages: 7

Oneida

XLDnaute Impliqué
Bonjour,
J'ai regarde la chose.
Vous avez un probleme entre votre pointeur i et la ligne 6 de depart pour vos boucles.
Vous devez avoir un ofser de 6 pas 1
Pas la peine de masquer les 4 premiers Tabs si vous faites cela.
Mais y a pas que ca, en fonction du choix Axe, y a pas les bonnes donnees. J'ai pas encore trouve le pourquoi
 

youky(BJ)

XLDnaute Barbatruc
Bonjour tous,
Macro du 1er combobox, la variable i ne suit pas les Tabs alors ajout variable k
Bruno
VB:
Private Sub FiltreAxe_Change()
Dim k%
Me.TabStrip1.Value = -1                                        'tabstrip no index start
    Do While TabStrip1.Tabs.Count > 1
        TabStrip1.Tabs.Remove (1)                           'remove all but first tab
    Loop
With GestionProjet.TabStrip1
For i = 0 To Cells(Rows.Count, 1).End(xlUp).Row - 1 'boucle 1  = boucle sur tous les projets de la liste
If Sheets("Liste projet").Cells(i + 1, 2).Value = FiltreAxe Then
        .Tabs.Add
        .Tabs(k).Caption = Sheets("Liste projet").Cells(i + 1, 4).Value
        k = k + 1
Axestrat = Sheets("Liste projet").Cells(i + 1, 2).Value
Thème = Sheets("Liste projet").Cells(i + 1, 3).Value
NomRéduit = Sheets("Liste projet").Cells(i + 1, 5).Value
Réferent = Sheets("Liste projet").Cells(i + 1, 6).Value
Datedébutprojet = Sheets("Liste projet").Cells(i + 1, 9).Value
Datefinprojet = Sheets("Liste projet").Cells(i + 1, 10).Value
End If
Next i
End With
End Sub
 

troki74

XLDnaute Nouveau
Bonjour,
J'ai regarde la chose.
Vous avez un probleme entre votre pointeur i et la ligne 6 de depart pour vos boucles.
Vous devez avoir un ofser de 6 pas 1
Pas la peine de masquer les 4 premiers Tabs si vous faites cela.
Mais y a pas que ca, en fonction du choix Axe, y a pas les bonnes donnees. J'ai pas encore trouve le pourquoi
Bonjour Oneida,
Merci pour votre retour.
Pour le décalage, si je démarre la boucle à i = 6 j'ai un bug erreur d'execution "5", il y a un moyen de dépasser cela?
 
Dernière édition:

troki74

XLDnaute Nouveau
Bonjour tous,
Macro du 1er combobox, la variable i ne suit pas les Tabs alors ajout variable k
Bruno
VB:
Private Sub FiltreAxe_Change()
Dim k%
Me.TabStrip1.Value = -1                                        'tabstrip no index start
    Do While TabStrip1.Tabs.Count > 1
        TabStrip1.Tabs.Remove (1)                           'remove all but first tab
    Loop
With GestionProjet.TabStrip1
For i = 0 To Cells(Rows.Count, 1).End(xlUp).Row - 1 'boucle 1  = boucle sur tous les projets de la liste
If Sheets("Liste projet").Cells(i + 1, 2).Value = FiltreAxe Then
        .Tabs.Add
        .Tabs(k).Caption = Sheets("Liste projet").Cells(i + 1, 4).Value
        k = k + 1
Axestrat = Sheets("Liste projet").Cells(i + 1, 2).Value
Thème = Sheets("Liste projet").Cells(i + 1, 3).Value
NomRéduit = Sheets("Liste projet").Cells(i + 1, 5).Value
Réferent = Sheets("Liste projet").Cells(i + 1, 6).Value
Datedébutprojet = Sheets("Liste projet").Cells(i + 1, 9).Value
Datefinprojet = Sheets("Liste projet").Cells(i + 1, 10).Value
End If
Next i
End With
End Sub
Bonjour Youki,
Merci également pour votre intervention.
J'ai testé et effectivement, les captions sont bien modifiées top !, enfin une lueur d'espoir.
Reste les valeurs des contrôles qui sont toujours fixes, ca bloque sur la première occurrence issue du filtre.
Voici le reste du code :
VB:
Private Sub TabStrip1_Change()
If FiltreAxe = "" Then

Dim i As Integer
For i = 0 To TabStrip1.Tabs.Count - 1
  Select Case TabStrip1.Value
                Case i
                
Axestrat = Sheets("Liste projet").Cells(i + 1, 2).Value
Thème = Sheets("Liste projet").Cells(i + 1, 3).Value
NomRéduit = Sheets("Liste projet").Cells(i + 1, 5).Value
Réferent = Sheets("Liste projet").Cells(i + 1, 6).Value
Datedébutprojet = Sheets("Liste projet").Cells(i + 1, 9).Value
Datefinprojet = Sheets("Liste projet").Cells(i + 1, 10).Value

End Select
Next i
End If

If FiltreAxe <> "" Then
For i = 0 To TabStrip1.Tabs.Count - 1
Select Case TabStrip1.Value
                Case i
                
If Sheets("Liste projet").Cells(i + 1, 2).Value = FiltreAxe Then Axestrat = Sheets("Liste projet").Cells(i + 1, 2).Value
If Sheets("Liste projet").Cells(i + 1, 2).Value = FiltreAxe Then Thème = Sheets("Liste projet").Cells(i + 1, 3).Value
If Sheets("Liste projet").Cells(i + 1, 2).Value = FiltreAxe Then NomRéduit = Sheets("Liste projet").Cells(i + 1, 5).Value
If Sheets("Liste projet").Cells(i + 1, 2).Value = FiltreAxe Then Réferent = Sheets("Liste projet").Cells(i + 1, 6).Value
If Sheets("Liste projet").Cells(i + 1, 2).Value = FiltreAxe Then Datedébutprojet = Sheets("Liste projet").Cells(i + 1, 9).Value
If Sheets("Liste projet").Cells(i + 1, 2).Value = FiltreAxe Then Datefinprojet = Sheets("Liste projet").Cells(i + 1, 10).Value
End Select

Next i
End If


End Sub
 

troki74

XLDnaute Nouveau
Il y a aussi un tab en trop à la fin du tabstrip, quelque soit le filtre sur l'axe
Pour les contrôles, maintenant qu'on a les captions qui sont filtrés (à l'exeption du dernier), j'ai pensé à faire une recherche sur ces derniers, mais je n'arrive pas à faire référence au caption du tab actif, voici un début de code :

VB:
Private Sub TabStrip1_Change()
Dim C As Range
Dim LastLig As Long, Lig As Long
If FiltreAxe = "" Then

Dim i As Integer
For i = 0 To TabStrip1.Tabs.Count - 1
  Select Case TabStrip1.Value
                Case i
              
Axestrat = Sheets("Liste projet").Cells(i + 1, 2).Value
Thème = Sheets("Liste projet").Cells(i + 1, 3).Value
NomRéduit = Sheets("Liste projet").Cells(i + 1, 5).Value
Réferent = Sheets("Liste projet").Cells(i + 1, 6).Value
Datedébutprojet = Sheets("Liste projet").Cells(i + 1, 9).Value
Datefinprojet = Sheets("Liste projet").Cells(i + 1, 10).Value

End Select
Next i
End If

If FiltreAxe <> "" Then
    With Sheets("Liste projet")
        LastLig = .Cells(Rows.Count, "D").End(xlUp).Row
        Set C = .Range("D6:D" & LastLig).Find(Me.TabStrip1.SelectedItem.Caption, LookIn:=xlValues, LookAt:=xlPart)
        If Not C Is Nothing Then
            Lig = C.Row 'dans Lig on a la ligne de la donnée trouvée
Axestrat = Range("B" & Lig).Value
Thème = Range("C" & Lig).Value
NomRéduit = Range("D" & Lig).Value
Réferent = Range("E" & Lig).Value
Datedébutprojet = Range("G" & Lig).Value
Datefinprojet = Range("H" & Lig).Value
End If
End With
End If


End Sub
J'ai une erreur variable objet non définie
 
Dernière édition:

troki74

XLDnaute Nouveau
Hello,
Youki, top, je peux enfin utiliser les filtres:)
Pour l'affichage de la liste complète lors de l'initialize c'était problématique ?
Je peux m'en dépatouiller si oui, en faisant deux modules l'un avec la liste complète l'autre avec les filtres.

Jean Marie, bien vu! Je souhaitais justement travailler sur l'utilisation des deux filtres en simultanées. Je vais essayer de voir si je peux adapter vos formules en ce sens

Super de pouvoir compter sur des gens expérimentés ici
 

troki74

XLDnaute Nouveau
Ca coince, les deux filtres fonctionnent individuellement, mais dès que l'on veut ajouter l'autre ça plante :
VB:
Private i As Integer 'déclare la variable I (Incréments)
Dim Tab_Referent()
Dim Tab_Axe()


Private Sub FiltreAxe_Change()
Dim k%
Axestrat = ""
Thème = ""
NomRéduit = ""
Réferent = ""
Datedébutprojet = ""
Datefinprojet = ""
Me.TabStrip1.Value = -1                                        'tabstrip no index start
    Do While TabStrip1.Tabs.Count > 1
        TabStrip1.Tabs.Remove (0)                           'remove all but first tab
    Loop
With GestionProjet.TabStrip1
For i = 0 To Cells(Rows.Count, 1).End(xlUp).Row - 1 'boucle 1  = boucle sur tous les projets de la liste
If Sheets("Liste projet").Cells(i + 5, 2).Value = FiltreAxe Then
    
        .Tabs.Add
        .Tabs(k).Caption = Feuil1.Cells(i + 5, 4).Value
              k = k + 1
              ReDim Preserve Tab_Referent(1 To k) 'on redimensionne le tableau temporaire
              Tab_Referent(k) = Feuil1.Cells(i + 5, 5).Value 'on récupére la valeur de la Colonne "Référent Projet"
    If k = 1 Then
    If TabStrip1.Tabs.Count > 1 Then TabStrip1.Tabs.Remove (1) 'supp tabs
Axestrat = Feuil1.Cells(i + 5, 2).Value
Thème = Feuil1.Cells(i + 5, 3).Value
NomRéduit = Feuil1.Cells(i + 5, 5).Value
Réferent = Feuil1.Cells(i + 5, 6).Value
Datedébutprojet = Feuil1.Cells(i + 5, 9).Value
Datefinprojet = Feuil1.Cells(i + 5, 10).Value
Label58 = i + 5
    End If
End If
Next i

End With
FiltreRéférent.Clear 'On vide le Control
[B][COLOR=rgb(247, 218, 100)]FiltreRéférent.List = Tab_Referent 'On remplit le Control[/COLOR][/B]
FiltreRéférent.ListIndex = IIf(k = 1, 0, -1) 'On affiche la valeur si un seul Choix
TabStrip1.Value = 0
Erase Tab_Referent 'On vide le tableau temporaire
End Sub


Private Sub FiltreRéférent_Change()
Dim k%
Axestrat = ""
Thème = ""
NomRéduit = ""
Réferent = ""
Datedébutprojet = ""
Datefinprojet = ""
Me.TabStrip1.Value = -1                                        'tabstrip no index start
    Do While TabStrip1.Tabs.Count > 1
        TabStrip1.Tabs.Remove (0)                           'remove all but first tab
    Loop
With GestionProjet.TabStrip1
For i = 0 To Cells(Rows.Count, 1).End(xlUp).Row - 1 'boucle 1  = boucle sur tous les projets de la liste
If Sheets("Liste projet").Cells(i + 5, 5).Value = FiltreRéférent Then
    
        .Tabs.Add
        .Tabs(k).Caption = Feuil1.Cells(i + 5, 4).Value
              k = k + 1
              ReDim Preserve Tab_Axe(1 To k) 'on redimensionne le tableau temporaire
              Tab_Axe(k) = Feuil1.Cells(i + 5, 2).Value 'on récupére la valeur de la Colonne "Référent Projet"
    If k = 1 Then
    If TabStrip1.Tabs.Count > 1 Then TabStrip1.Tabs.Remove (1) 'supp tabs
Axestrat = Feuil1.Cells(i + 5, 2).Value
Thème = Feuil1.Cells(i + 5, 3).Value
NomRéduit = Feuil1.Cells(i + 5, 4).Value
Réferent = Feuil1.Cells(i + 5, 5).Value
Datedébutprojet = Feuil1.Cells(i + 5, 7).Value
Datefinprojet = Feuil1.Cells(i + 5, 8).Value
Label58 = i + 5
    End If
End If
Next i

End With
FiltreAxe.Clear 'On vide le Control
[B][COLOR=rgb(247, 218, 100)]FiltreAxe.List = Tab_Axe 'On remplit le Control[/COLOR][/B]
FiltreAxe.ListIndex = IIf(k = 1, 0, -1) 'On affiche la valeur si un seul Choix
TabStrip1.Value = 0
Erase Tab_Axe 'On vide le tableau temporaire
End Sub

Private Sub UserForm_Initialize()

Set f = Sheets("Liste projet")
  Set MonDico = CreateObject("Scripting.Dictionary")
  a = f.Range("B6:B" & f.[A65000].End(xlUp).Row) ' tableau a(n,1) pour rapidité
  For i = LBound(a) To UBound(a)
    If a(i, 1) <> "" Then MonDico(a(i, 1)) = ""
  Next i
 
  Me.FiltreAxe.List = MonDico.keys

  Set MonDico = CreateObject("Scripting.Dictionary")
  a = f.Range("E6:E" & f.[A65000].End(xlUp).Row) ' tableau a(n,1) pour rapidité
  For i = LBound(a) To UBound(a)
    If a(i, 1) <> "" Then MonDico(a(i, 1)) = ""
  Next i
  Me.FiltreRéférent.List = MonDico.keys
 
Me.Left = Application.Left + Application.Width / 2 - Me.Width / 2
Me.Top = Application.Top + Application.Height / 2 - Me.Height / 2
End Sub

Erreur 380 : Impossible de définir la propriété list
 

Pièces jointes

  • TableauSubvention v filtre.xlsm
    41.8 KB · Affichages: 2

troki74

XLDnaute Nouveau
Merci encore youki, c'est nickel.
Je pensais au départ cumuler les deux filtres (en cascade) mais je vais déjà essayer d'appliquer ce que tu propose à mon tableau (c'est pas une mince affaire).
Si ça coince je reviens. Si c'est tout bon je passerais en résolu.
 

Discussions similaires

Statistiques des forums

Discussions
313 229
Messages
2 096 393
Membres
106 599
dernier inscrit
waillas