Utiliser les filtres avec une macro VBA

**levothy** · 03/05/2016, 18h24

Bonjour à tous;

Urgent besoin d'aide.
Je suis également débutante en vba, cela dit j'essaye de m'améliorer

voici ci joint mon fichier, il s'agit de gestion de maintenance préventive. Ma macro maintenance fonctionne relativement bien si le fichier n'est pas trop lourd (peu de lignes). Par contre cela rame avec un nombre important de lignes (3000 environ).
Je souhaite donc utiliser des filtres sur ma feuille PMP_2016, puis lancer ma macro en fonction des filtres ajoutés (par exemple code atelier BREBIOU et année 2016 dans date de la prochaine intervention).
En résumé je souhaite que ma macro se lance que pour les lignes sélectionnées via les filtres.

Merci à vous

fab

**Menhir** · 04/05/2016, 12h16

Envoyé par levothy

voici ci joint mon fichier

http://www.developpez.net/forums/d84...s-discussions/

En résumé je souhaite que ma macro se lance que pour les lignes sélectionnées via les filtres.

Pour sélectionner uniquement les cellules visibles, le plus pratique est d'utiliser la méthode SpecialCells(xlCellTypeVisible) de l'objet Range appliqué à la colonne où se trouve les données à traiter.
https://msdn.microsoft.com/fr-fr/lib.../ff196157.aspx

**Kiouane** · 04/05/2016, 13h14

Tu peux utiliser ceci pour t'inspirer.

Code :

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

1
2
3
4
5
6
Sub ()
With Range(Range("A1"), Range("C4000").End(xlUp))
       .AutoFilter Field:=1, Criteria1:="2016"
       .SpecialCells(xlCellTypeVisible).EntireRow.select
End With
End Sub

Cette macro permet de sélectionner toutes les lignes contenant 2016 dans ta plage de données.

**levothy** · 04/05/2016, 13h43

j'ai essayé de modifier mon sub maintenance comme suit, mais cela bug

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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
Sub Maintenance()    'chaque clique ou chaque changement de cellule
 
nom_feuille = ActiveWorkbook.ActiveSheet.Name                  'recuperation du nom de la feuille
If ActiveCell.Column = 8 Or ActiveCell.Column = 7 Or ActiveCell.Column = 16 Or ActiveCell.Column = 9 Or ActiveCell.Column = 19 Then Exit Sub 'la macro n'est pas réalisée lorsque l'on clique dans les colonne G et H
If sortie_macro = 1 Then Exit Sub
 
'initialisation des variables
t = 0
aujourdhui = Date
lignetitre = 8
lastmaint = "P"
nextmaint = "Q"
typefreq = "O"
freq = "N"
i = lignetitre
freq1 = "jour"
freq2 = "mois"
freq3 = "an"
freq4 = "cycle"
 
message_alerte = 0
pre_alerte = -7                                            'message alerte s'affiche tant de jour(s) avant la date de la prochaine maintenance
 
Application.ScreenUpdating = False
Range(Range("A" & Rows.Count).End(xlUp), Cells(8, 1)).Select
 
'on place dans un tableau les N° de lignes visibles
For Each cellule In Selection.SpecialCells(xlCellTypeVisible)
On Error Resume Next
Tablo.Add cellule.Row, CStr(cellule.Row)
Next cellule
 
'initialisation du message d'erreur
 
Msg = "Au moins une des opérations doit être envisagée dans les " & Abs(pre_alerte) & " prochains jours. Voulez-vous accedez à la premiere intervention ?"   ' Définit le message.
Style = vbYesNo + vbCritical + vbDefaultButton2                 'Définit les boutons.
Title = "Message d'ALERTE "                                     'Définit le titre.
 
 
'on reprend les N° de lignes depuis la fin du tableau
For N = Tablo.Count To 0 Step -1
 
 
    celltypefreq = typefreq & N                                 'cellule à lire
    If Range(celltypefreq) = freq1 Then decalage = "d"          'determination du type de décalage determiné par le type de fréquence
    If Range(celltypefreq) = freq2 Then decalage = "m"         'determination du type de décalage determiné par le type de fréquence
    If Range(celltypefreq) = freq3 Then decalage = "yyyy"       'determination du type de décalage determiné par le type de fréquence
    If Range(celltypefreq) = freq4 Then                         'écrit "suivant fréquence" dans cellule "date prochaine maintenance"
             celldatnextmaint = nextmaint & N: Range(celldatnextmaint).Value = "suivant frequence": GoTo ligne1
    End If                                                      'à modifier suivant le type de fréquence
    'calcul de la prochaine date de maintenance
    cellfreq = freq & N                                         'cellule à lire
    datelastmaint = DateValue(Cells(N, lastmaint).Value)        'mise en forme de la date de la derniere maintenance
    nbrefreq = Range(cellfreq).Value                            'récuperation de la fréquence
    journextmaint = DateAdd(decalage, nbrefreq, datelastmaint)  'calcul du jour de la prochaine maintenance
 
    celldatnextmaint = nextmaint & N                            'cellule de destination
    Range(celldatnextmaint).Value = journextmaint               'écriture dans la cellule de destination
 
    date_alerte = DateAdd("d", pre_alerte, journextmaint)
    If aujourdhui >= date_alerte Then message_alerte = 1: tabrep(t) = N: t = t + 1    'test pour message d'alerte, on met message_alerte à 1 si au
                                                                                        'moins une date dépassée, on met le numéro de ligne dans le tableau
                                                                                        'tabrep à la position t
ligne1:
Next
'Application.ScreenUpdating = True
If message_alerte = 1 Then Reponse = MsgBox(Msg, Style, Title) 'affichage du message
 
postabrep = 0                                                  'initilaisation de la position dans le tableau tabrep()
premierelignemauvaise = lastmaint & tabrep(postabrep)          'position de la premiere cellule rouge
If Reponse = vbYes Then sortie_macro = 1: affichage_messages
sortie_macro = 0
End Sub

Pourriez vous m'indiquer où est l'erreur
merci pour votre aide

**Menhir** · 04/05/2016, 14h22

Envoyé par levothy

j'ai essayé de modifier mon sub maintenance comme suit, mais cela bug

Surtout ne prend pas la peine de décrire le problème... "cela bug", c'est tellement clair comme description.

Qu'est-ce qui se passe ? Quelle est le message d'erreur affiché ? Sur quelle ligne se produit le bug ?

Autre conseil : quand tu mets du code dans un message, encadre-le des balise CODE (l'icone # dans l'éditeur).

**levothy** · 04/05/2016, 15h34

ok Menhir, merci pour le conseil, sans les filtres cela fonctionne quand on utilise la boucle do, mais pour un nombre restreint de lignes. Je ne sais pas comment faire cette même boucle en utilisant uniquement les cellules filtrées.
voici le message d'erreur

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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
Sub Maintenance()    'chaque clique ou chaque changement de cellule
 
nom_feuille = ActiveWorkbook.ActiveSheet.Name                  'recuperation du nom de la feuille
If ActiveCell.Column = 8 Or ActiveCell.Column = 7 Or ActiveCell.Column = 16 Or ActiveCell.Column = 9 Or ActiveCell.Column = 19 Then Exit Sub 'la macro n'est pas réalisée lorsque l'on clique dans les colonne G et H
If sortie_macro = 1 Then Exit Sub
 
'initialisation des variables
t = 0
aujourdhui = Date
lignetitre = 8
lastmaint = "P"
nextmaint = "Q"
typefreq = "O"
freq = "N"
i = lignetitre
freq1 = "jour"
freq2 = "mois"
freq3 = "an"
freq4 = "cycle"
 
message_alerte = 0
pre_alerte = -7                                            'message alerte s'affiche tant de jour(s) avant la date de la prochaine maintenance
 
 
'Do
 
'    i = i + 1
 
'Loop Until Cells(i, 2) = ""
'ReDim tabrep(i)
'nbreligne = i - lignetitre - 1                                  'nombre de ligne d'opération de maintenance
'premiereligne = lignetitre + 1
Application.ScreenUpdating = False
 Range(Range("A" & Rows.Count).End(xlUp), Cells(9, 1)).Select
 
 'on place dans un tableau les N° de lignes visibles
 Dim Tablo As New Collection, cellule As Range
 For Each cellule In Selection.SpecialCells(xlCellTypeVisible)
 On Error Resume Next
 Tablo.Add cellule.Row, CStr(cellule.Row)
 Next
 
 'initialisation du message d'erreur
 
 Msg = "Au moins une des opérations doit être envisagée dans les " & Abs(pre_alerte) & " prochains jours. Voulez-vous accedez à la premiere intervention ?" ' Définit le message.
 Style = vbYesNo + vbCritical + vbDefaultButton2 'Définit les boutons.
 Title = "Message d'ALERTE " 'Définit le titre.
ReDim tabrep(Tablo.Count)
 
 'on reprend les N° de lignes depuis la fin du tableau
 For N = Tablo.Count To 0 Step -1
 
 
'For N = premiereligne To i - 1
 
    celltypefreq = typefreq & N                                 'cellule à lire
    If Range(celltypefreq) = freq1 Then decalage = "d"          'determination du type de décalage determiné par le type de fréquence
    If Range(celltypefreq) = freq2 Then decalage = "m"         'determination du type de décalage determiné par le type de fréquence
    If Range(celltypefreq) = freq3 Then decalage = "yyyy"       'determination du type de décalage determiné par le type de fréquence
    If Range(celltypefreq) = freq4 Then                         'écrit "suivant fréquence" dans cellule "date prochaine maintenance"
             celldatnextmaint = nextmaint & N: Range(celldatnextmaint).Value = "suivant frequence": GoTo ligne1
    End If                                                      'à modifier suivant le type de fréquence
    'calcul de la prochaine date de maintenance
    cellfreq = freq & N                                         'cellule à lire
    datelastmaint = DateValue(Cells(N, lastmaint).Value)        'mise en forme de la date de la derniere maintenance
    nbrefreq = Range(cellfreq).Value                            'récuperation de la fréquence
    journextmaint = DateAdd(decalage, nbrefreq, datelastmaint)  'calcul du jour de la prochaine maintenance
 
    celldatnextmaint = nextmaint & N                            'cellule de destination
    Range(celldatnextmaint).Value = journextmaint               'écriture dans la cellule de destination
 
    date_alerte = DateAdd("d", pre_alerte, journextmaint)
    If aujourdhui >= date_alerte Then message_alerte = 1: tabrep(t) = N: t = t + 1    'test pour message d'alerte, on met message_alerte à 1 si au
                                                                                        'moins une date dépassée, on met le numéro de ligne dans le tableau
                                                                                        'tabrep à la position t
ligne1:
Next
 
Application.ScreenUpdating = True
If message_alerte = 1 Then Reponse = MsgBox(Msg, Style, Title) 'affichage du message
 
postabrep = 0                                                  'initilaisation de la position dans le tableau tabrep()
premierelignemauvaise = lastmaint & tabrep(postabrep)          'position de la premiere cellule rouge
If Reponse = vbYes Then sortie_macro = 1: affichage_messages
sortie_macro = 0
End Sub

**Menhir** · 04/05/2016, 15h57

Un conseil d'abord : commence par enlever de ton code tout ce qui empêche de débuger correctement le code en phase de développement.
Entre autre :

Code :

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

Application.ScreenUpdating = False

et

Code :

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

On Error Resume Next

Essaye aussi de te passer de "Selection" et de placer la méthode directement sur le Range.
J'ai déjà eu le cas où des méthodes ou propriétés ne marchaient pas sur Selection alors qu'un Range était sélectionné.

**joe.levrai** · 04/05/2016, 16h12

Bonjour,

il semblerait, au vu de ton code et du message d'erreur, que la plage représentée par Selection ne contient aucune ligne Visible !

vérifie la propriété .Address de cette plage et regarde si tu as au moins un élément visible

**Menhir** · 04/05/2016, 16h48

Envoyé par joe.levrai

vérifie la propriété .Address de cette plage et regarde si tu as au moins un élément visible

Ou la propriété .Count.

Mais même s'il n'y a pas de lignes visibles, ça ne devrait pas planter le code.
Ca se contentera de shunter la boucle For Each.
Pour que ça plante, il faudrait que Selection soit autre chose qu'un Range.

A moins ce ne soit Nothing.
Au lieu de faire un Select, mets ta plage dans une variable de type Range. Au moins on pourra voir ce qu'il y a dedans.

**joe.levrai** · 04/05/2016, 17h25

Non, si la sélection ne contient AUCUNE ligne visible, ça ne renverra pas 0 ou nothing, ça va planter

SpecialCells est une METHODE et pas une PROPRIETE.

essaye ça dans un fichier vierge

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
Sub toto()
 
Rows(3).Hidden = False
 
' ici ça va afficher le nombre de colonnes du classeur
With Rows(3).SpecialCells(xlCellTypeVisible)
    MsgBox .Count
End With
 
 
Rows(3).Hidden = True
 
' ici ça va planter
With Rows(3).SpecialCells(xlCellTypeVisible)
    MsgBox .Count
End With
 
End Sub

C'est même moins permissif que FIND, puisqu'on peut pas tester si l'objet renvoyé est NOTHING quand il n'y a rien :

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
Sub toto()
Dim MaPlage As Range
 
' ici ça passe : on obtient FAUX
Rows(3).Hidden = False
Set MaPlage = Rows(3).SpecialCells(xlCellTypeVisible)
MsgBox MaPlage Is Nothing
 
' ici ça plante
Rows(3).Hidden = True
Set MaPlage = Rows(3).SpecialCells(xlCellTypeVisible)
MsgBox MaPlage Is Nothing
 
 
End Sub

Le moins pire que j'utilise, c'est de gérer l'erreur, un exemple en passant par une variable (mais c'est pas nécessaire) :

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
Sub toto()
Dim MaPlage As Range
 
Rows(3).Hidden = True
 
    On Error Resume Next
        Set MaPlage = Rows(3).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
 
    If Not MaPlage Is Nothing Then
        MsgBox "Il y a des cellules visibles"
    Else
        MsgBox "Aucune cellule visible"
    End If
End Sub

Si quelqu'un a plus joli, je suis preneur à 1000%

**levothy** · 04/05/2016, 19h48

j'ai modifié mon programme en prenant compte de vos conseils

cela va un peu mieux, mais ce n'est pas encore bon: normalement quant je lance la macro, le programme me prévient par un message 7 jours avant que j'ai une maintenance à effectuer sur la ligne concernée de même pour les interventions dépassées. Puis cela doit m'afficher une fenêtre description de l'intervention pour la ligne concernée.

dans mon nouveau programme, cela m'affiche le message, puis ensuite une série de date (la même) s'inscrit dans la colonne q (équivalente au nombre de mes lignes concernées par l'alerte, de q1 à q8 dans cet exemple), puis la fenêtre description s'affiche pour les nouvelles lignes en colonne q.