Microsoft 365 filtre sur un tabstrip depuis un combobox

T

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
Trier par date Trier par votes
Oneida

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
 
Vote positif 0 Vote négatif
youky(BJ)

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
 
Vote positif 0 Vote négatif
T

troki74

XLDnaute Nouveau
Oneida à dit:
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
Cliquez pour agrandir...
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:
Vote positif 0 Vote négatif
T

troki74

XLDnaute Nouveau
youky(BJ) à dit:
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
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
T

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:
Vote positif 0 Vote négatif
T

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
 
Vote positif 0 Vote négatif
T

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
Vote positif 0 Vote négatif
T

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.
 
Vote positif 0 Vote négatif

Discussions similaires

T
  • Question
Microsoft 365 Problème affichage multipage dans un tabstrip
Réponses
1
Affichages
483
troki74
T
D
  • Question
XL 2021 Filtre Multi Critères Listview VBA
2
Réponses
21
Affichages
1 K
Dranreb
Dranreb
M
  • Question
XL 2010 Aide à la suppression d'un produit en double dans un magasin spécifique avec conditions
Réponses
9
Affichages
688
Mody200
M
A
  • Résolu(e)
XL 2016 Alimentation d'un fichier selon données sélectionnées via une ComboBox
Réponses
3
Affichages
505
Aldonanou
A
C
  • Question
Autres bug sur une procédure avec textbox contenant un code barre
2
Réponses
15
Affichages
1 K
TooFatBoy
TooFatBoy
J
  • Résolu(e)
XL 2021 Boucler sur un combobox d'une feuille Excel (Pas un Usf)
Réponses
8
Affichages
619
jozerebel
J
F
  • Question
XL 2010 combobox dépendante les unes aux autres
Réponses
4
Affichages
646
ChTi160
ChTi160
xtor
  • Question
XL 2019 Combobox depuis une autre feuille
Réponses
11
Affichages
1 K
ChTi160
ChTi160
K
  • Résolu(e)
XL 2019 Copier Seulement les lignes affichée après un filtre de tableau
Réponses
9
Affichages
1 K
Kushi
K
A
  • Question
XL 2010 Date dans fichier pour impression pdf
Réponses
2
Affichages
891
Aldonanou
A

Membres actuellement en ligne

15 membres et 185 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 716
Messages
2 112 161
Membres
111 447
dernier inscrit
jasontantane