Filtre horizontal en vba

Version imprimable

21/07/2012, 12h03
mattaw7

1 pièce(s) jointe(s)

Filtre horizontal en vba

Bonjour,

Je dispose d'un fichier Excel en pièce jointe et je souhaite mettre en place un filtre horizontal sur la première ligne "Formation" sous la forme d'un bouton "Rechercher une formation".

Dès que l'on clique sur ce bouton, un UserForm s'ouvre avec une liste de l'ensemble des formations.

Quand on sélectionne la formation voulu on clique sur OK et le tableau affiche uniquement la formation voulu avec le détail.

Merci beaucoup de vos propositions par avance.
21/07/2012, 15h06
Philippe Tulliez

Bonjour,
Voir réponse ici sujet similaire.

Bonjour,

En partant d'un UseForm contant un ListBox et un bouton <Ok>:

Code:

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
'Bouton <Ok>'
Private Sub CommandButton1_Click()
    Dim lastCol As Integer
    lastCol = Range("B1").End(xlToRight).Column
 
    Application.ScreenUpdating = False
        Range(Cells(1, 2), Cells(1, lastCol)).EntireColumn.Hidden = True
        Columns(ComboBox1.ListIndex + 2).EntireColumn.Hidden = False
        UserForm1.Hide
    Application.ScreenUpdating = True
End Sub
 
'Affichage du UserForm
Private Sub UserForm_Activate()
    Dim lastCol As Integer
 
    Application.ScreenUpdating = False
        Range(Cells(1, 2), Cells(1, Columns.Count)).EntireColumn.Hidden = False
        lastCol = Range("B1").End(xlToRight).Column
 
        Dim vals As Variant
        vals = Range(Cells(1, 2), Cells(1, lastCol))
 
        ComboBox1.Clear
        Dim vali As Integer
        For vali = 1 To UBound(vals, 2)
            Call ComboBox1.AddItem(vals(1, vali))
        Next vali
        ComboBox1.Text = vals(1, 1)
    Application.ScreenUpdating = True
 
End Sub

21/07/2012, 18h15
BlueMonkey

1 pièce(s) jointe(s)

Citation:

Envoyé par mattaw7

Merci BlueMonkey.
Peux-tu l'intégrer dans mon fichier joint dans mon message précédent, cela m'aiderai énormément.
Merci d'avance.

Ci-joint un fichier intégrant le filtre horizontal.

Quelques informations sur le fonctionnement du forum :
- les sujet doivent être traité sur le forum. Merci d'utiliser le bouton <Ajouter une réponse> pour les questions techniques
et de ne conserver <MP> que pour des messages privés.
- au sujet des pièces jointes sur les premiers post voir ici.

A+
21/07/2012, 18h28
mattaw7

Merci encore BlueMonkey.

C'est exactement ce que je veux. Par contre, j'ai deux questions:

1/ A quoi sert le module1?
2/ Mon fichier final comportera énormément de formations donc énormément de colonnes. Qu'est ce qu'il faut modifier dans le code pour avoir le choix dans le filtre sur toute les formations?
21/07/2012, 18h42
BlueMonkey

Citation:

A quoi sert le module1?

A rien, c'était pour faire des tests.

Citation:

Qu'est ce qu'il faut modifier dans le code pour avoir le choix dans le filtre sur toute les formations?

Rien, tant que les formations sont en ligne 1.
21/07/2012, 19h10
mattaw7

Merci beaucoup BlueMonkey.

C'est plus que parfait.

Je souhaite par contre protéger le classeur par un mot de passe afin d'être le seul à pouvoir le modifier et avec la protection intégrer à Excel, ça bug.

Je pense que l'on peut intégrer un code mais je sais pas comment faire.

Merci de ton retour

La protection sur la feuille provoque une erreur au moment de masquer/afficher les colonnes.

Pour corriger ce problème, utilise les instructions ActiveSheet.Protect <mot de passe> et ActiveSheet.UnProtect <Mot de passe>

Dans le code de "Feuil1" ça donne :

Code:

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
40
41
42
Private Sub ProtegeFeuille(isActive As Boolean)
    If isActive Then
        ActiveSheet.Protect 'mot de passe à ajouter
    Else
        ActiveSheet.Unprotect 'mot de passe à ajouter
    End If
 
End Sub
 
Private Sub CB_Ok_Click()
    Dim lastCol As Integer
    lastCol = Range("B1").End(xlToRight).Column
    Application.ScreenUpdating = False
        Call ProtegeFeuille(False)
            Range(Cells(1, 2), Cells(1, lastCol)).EntireColumn.Hidden = True
            Columns(CB_LisFormation.ListIndex + 2).EntireColumn.Hidden = False
            UF_Filtre.Hide
        Call ProtegeFeuille(True)
    Application.ScreenUpdating = True
 
End Sub
 
Private Sub UserForm_Activate()
    Dim lastCol As Integer
    With ActiveSheet
        Call ProtegeFeuille(False)
            Range(Cells(1, 2), Cells(1, Columns.Count)).EntireColumn.Hidden = False
        Call ProtegeFeuille(True)
        lastCol = .Range("B1").End(xlToRight).Column
 
        Dim vals As Variant
        vals = Range(.Cells(1, 2), .Cells(1, lastCol))
 
        CB_LisFormation.Clear
        Dim vali As Integer
        For vali = 1 To UBound(vals, 2)
            Call CB_LisFormation.AddItem(vals(1, vali))
        Next vali
        CB_LisFormation.Text = vals(1, 1)
    End With
 
End Sub

Maintenant, le niveau de protection apporté est assez minime.
(voir ce sujet)

Bonjour,
En vba, il n'est pas utile de déprotéger et ensuite de reprotéger pour écrire dans une feuille protégée, il suffit en protégeant la feuille de donner la valeur True à l'argument nommé UserinterfaceOnly
Exemple :
Code:

1 2 3 4 5 6 7 8 9 Sub Test() Dim sht As Worksheet Set sht = ThisWorkbook.Worksheets("Feuil2") With sht .Protect Password:="toto", UserinterfaceOnly:=True .EnableSelection = xlUnlockedCells End With sht.Range("A1") = "Coucou" End Sub

Bonsoir,

Merci Corona pour cette précision. (désolé mon double post aveugle maintenant supprimé, lié à un plantage de mon navigateur)

Ci-dessous une adaptation du code avec ta solution.

Code:

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()
    With ActiveSheet
        .Protect UserinterfaceOnly:=True 'Password:="<le mot de passe>",
        .EnableSelection = xlUnlockedCells
    End With
End Sub
 
Private Sub CB_Ok_Click()
    Dim lastCol As Integer
    lastCol = Range("B1").End(xlToRight).Column
    Application.ScreenUpdating = False
        Range(Cells(1, 2), Cells(1, lastCol)).EntireColumn.Hidden = True
        Columns(CB_LisFormation.ListIndex + 2).EntireColumn.Hidden = False
        UF_Filtre.Hide
    Application.ScreenUpdating = True
 
End Sub
 
Private Sub UserForm_Activate()
    Dim lastCol As Integer
    With ActiveSheet
        Range(Cells(1, 2), Cells(1, Columns.Count)).EntireColumn.Hidden = False
        lastCol = .Range("B1").End(xlToRight).Column
 
        Dim vals As Variant
        vals = Range(.Cells(1, 2), .Cells(1, lastCol))
 
        CB_LisFormation.Clear
        Dim vali As Integer
        For vali = 1 To UBound(vals, 2)
            Call CB_LisFormation.AddItem(vals(1, vali))
        Next vali
        CB_LisFormation.Text = vals(1, 1)
    End With
 
End Sub

22/07/2012, 10h14
mattaw7

Le code est parfait à une chose prêt.

Il est possible pour une personne de voir et modifier les codes vba et aussi de voir le mot de passe pour déverrouiller la feuille.

Merci de me dire s'il y a une solution pour que les personnes n'aient accès qu'au bouton filtrer et pas autre chose et que moi je puisse modifier les choses avec un mot de passe.
22/07/2012, 10h26
BlueMonkey

Bonjour,

Il suffit de protéger le projet par un mot de passe.
Sous l'éditeur VBA :
- clic droit sur le projet,
- onglet protection,
- cocher verrouiller le projet pour l'affichage.
- saisir un mot de passe dans la zone prévue.
23/07/2012, 08h58
mattaw7

Bonjour,

Mon fichier est presque terminé.

Je souhaite savoir s'il est possible de masquer toute les colonnes sauf la colonne A à l'ouverture du fichier.
Dès que l'on clique sur le bouton "Filtrer" seul le UserForm s'affiche et dès que l'on choisit une formation, cette dernière s'affiche en cliquant sur Valider.

Merci de votre retour.

Bonsoir,

Le code de la UserForm devient :

Code:

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
Private Sub CB_Ok_Click()
    Dim lastCol As Integer
    lastCol = Range("B1").End(xlToRight).Column
    Application.ScreenUpdating = False
        Range(Cells(1, 2), Cells(1, lastCol)).EntireColumn.Hidden = True
        Columns(CB_LisFormation.ListIndex + 2).EntireColumn.Hidden = False
        UF_Filtre.Hide
    Application.ScreenUpdating = True
    Application.Visible = True
 
End Sub
 
Private Sub UserForm_Activate()
    Dim lastCol As Integer
    Application.Visible = False
    With ActiveSheet
        Range(Cells(1, 2), Cells(1, Columns.Count)).EntireColumn.Hidden = False
        lastCol = .Range("B1").End(xlToRight).Column
 
        Dim vals As Variant
        vals = Range(.Cells(1, 2), .Cells(1, lastCol))
 
        CB_LisFormation.Clear
        Dim vali As Integer
        For vali = 1 To UBound(vals, 2)
            Call CB_LisFormation.AddItem(vals(1, vali))
        Next vali
        CB_LisFormation.Text = vals(1, 1)
    End With
 
End Sub

Dans le code du classeur "ThisWorkbook"

Code:

1
2
3
4
5
6
7
8
9
10
Private Sub Workbook_Activate()
    Application.ScreenUpdating = False
    With ActiveSheet
        .Protect UserinterfaceOnly:=True 'Password:="<le mot de passe>",
        .EnableSelection = xlUnlockedCells
        .Range(.Cells(1, 2), .Cells(1, Columns.Count)).EntireColumn.Hidden = True
    End With
    Application.ScreenUpdating = True
 
End Sub

24/07/2012, 21h13
mattaw7

1 pièce(s) jointe(s)

Je viens de tester ta réponse BlueMonkey mais j'ai un bug en lançant le fichier excel:

Erreur d'exécution '1004':
Impossible de définir la propriété Hidden de la classe Range.

En pièce jointe, la copie d'écran du bug.

Merci de ton retour.
24/07/2012, 22h35
BlueMonkey
Bonsoir,

Etrange, je ne reproduit pas le problème.
La reproduction du bug est peut être lié à des temps différence de temps d'ouverture du fichier et d'initialisation du classeur.

Peut être que ça fonctionnera mieux en remplaçant

Code:

.Range(.Cells(1, 2), .Cells(1, Columns.Count)).EntireColumn.Hidden = True

par
Code:

1 2 .Range(.Cells(1, 2), .Cells(1, Columns.Count)).Select Selection.EntireColumn.Hidden = True
25/07/2012, 09h11
mattaw7

Merci BlueMonkey, mais l'erreur persiste.

Peux-tu m'envoyer le fichier que tu possèdes et qui fonctionne afin de le tester?

Merci encore.
25/07/2012, 13h02
BlueMonkey

1 pièce(s) jointe(s)

Bonjour,

Ci-joint le fichier contenant les modifications de colonnes masquées à l'ouverture.