findnext et hidden

Version imprimable

findnext et hidden

Bonjour à tous,

je débute dans l'utilisation de vba sous excel et je n'arrive pas a faire ce que je veux.

Voici ma problématique, je veux créer un bouton masquer/démasquer qui permettra donc de masquer ou demasquer les lignes entières de mes feuillets 2 à 6 en fonction de la valeur contenue dans la colonne K. En faites, si dans Ki j'ai "---" alors je veux masquer la ligne i.

J'ai réussi à le faire avec une boucle mais je veux le faire avec la fonction find (pour ma culture personnelle).

J'ai testé le code suivant:
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 Sub MasquerDemasquer() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For I = 2 To 6 With Sheets(I) .Activate .Unprotect Password:="Toto" Dim c As Range Set c = Range("K14:K100") With c.Find("---") c.EntireRow.Select If c.Hidden = True Then c.Hidden = False Else c.Hidden = True End If End With End With Next Sheets(1).Activate Application.Calculation = xlAutomatic Application.ScreenUpdating = True End Sub
Bien sûr cela ne fonctionne pas....

Quelqu'un peut-il éclairer ma lanterne?

merci

10/05/2013, 11h52
Marc-L

Bonjour.

Cela ne peut fonctionner car la méthode Find n'est pas respectée : il manque l'affectation d'une variable objet (ou Range) et le passage de paramètres !

Voir l'aide de Find appliquée à un Range et son exemple (notamment respecter la structure avec le FindNext) …

salut

bon après avoir fouillé dans l'aide, j'ai testé ceci:

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
 
Sub MasquerDemasquer()
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
 For I = 2 To 6
 With Worksheets(I).Range("K14:K100")
 .Activate
 .Unprotect Password:="Toto"
 
 Set c = .Find("---", LookIn:=xlValues)
 
     If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.EntireRow.Select
                If c.Hidden = True Then
                c.Hidden = False
                Else
                c.Hidden = True
                End If
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
Next
    Worksheets(1).Activate
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub

mais j'ai l'erreur 1004 sur le .Activate

10/05/2013, 14h17
SfJ5Rpw8

Citation:

Envoyé par waspy59

mais j'ai l'erreur 1004 sur le .Activate

ben supprime la ligne...
10/05/2013, 15h01
waspy59

salut

tu penses bien que j'ai essayé...

j'ai viré les lignes
- .activate
- .Unprotect Password:="Toto"

Mais du coup je recupere la même erreur à la ligne "c.EntireRow.Select" et si je la vire, c'est la ligne du dessous en erreur (tjrs la 1004)

Comprends pas trop où est le soucis
10/05/2013, 15h09
SfJ5Rpw8

il y as combien de feuilles dans ton classeur?

re,

Il y a 7 feuilles sur mon classeurs, mais je ne veux appliquer ma macro qu'aux feuilles 2 à 6.

Toutes mes feuilles et mon classeur sont protégés et sur les lignes a masquer il y a des commentaires (j'ai vu que ça pouvait poser soucis pour le masquage).

J'ai fait la modif, ci-dessous. La macro se deroule sans erreur mais en fait dans le find, il ne boucle pas

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
 
Sub MasquerDemasquer()
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
 For I = 2 To 6
 With Sheets(I)
 
 .Activate
 .Unprotect Password:="Toto"
 
 Dim s As Shape
 On Error Resume Next
 For Each s In ActiveSheet.Shapes
 s.Placement = xlMoveAndSize
 Next
 
 Set c = Sheets(I).Range("K14:K100").Find("---", LookIn:=xlValues)
 
     If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.EntireRow.Select
                If c.Hidden = True Then
                c.Hidden = False
                Else
                c.Hidden = True
                End If
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
 
End With
Next
    Worksheets(1).Activate
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub

10/05/2013, 16h16
SfJ5Rpw8

Pourquoi as tu rajouté la ligne :

Code:

On Error Resume Next

si tu veux que ton code fonctionne tu ne peu pas te contenter de masquer les erreurs ...

supprime cette ligne ... ou traite ces erreurs ...
10/05/2013, 16h23
waspy59

c'était dans l'exemple fournit par Microsoft... dans le doute je l'ai mis.
10/05/2013, 16h49
patricktoulon

re

Bonjour

avec le model que tu trouve qans l'aide (vbe) tu faire tres facilement ce que tu desire

le seul probleme c'est que tu ne peut pas rendre invisible ou supprimer la ligne dans la boucle do loop pour la simple et bonne raison que si tu la cache ou supprime next c ne veut plus rien dire

dans ta boucle collectionne les lignes dans une variable et apres la boucle sert toi de cette variable avec

Code:

rows(x:x).veryhidden=true

x representant ta variable
Au plaisir
10/05/2013, 16h52
SfJ5Rpw8

et essai de comprendre comment fonctionne l'instruction With ... (voir aide en ligne) ..

exemple:

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
 
Sub MasquerDemasquer()
    Dim s As Shape, i As Long, a As Long, e As Long
    Dim tablosupp() As Variant
    For i = 1 To 6
        e = 0
        For Each s In Sheets(i).Shapes
            s.Placement = xlMoveAndSize    'on replacera automatiquement les shapes
        Next
        With Sheets(i).Range("K14:K100")
            Set c = .Find("---", LookIn:=xlValues)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    e = e + 1
                    ReDim Preserve tablosupp(1 To e) ' on redimention notre tablo +1 et on ajoute la derniere adresse trouvée
                    tablosupp(e) = c.Address
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
 
            For a = 1 To UBound(tablosupp)
                Sheets(i).Range(tablosupp(a)).EntireRow.Hidden = True
            Next
        End With
    Next i
End Sub

Au plaisir

Bon j'ai parlé trop vite...

j'ai une erreur d’exécution 9, sur le code suivant:

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
43
44
45
46
47
48
49
50
51
52
 
Sub MasquerDemasquer()
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
USFwait.Show 0
USFwait.Repaint
 
For I = 2 To 7
    e = 0
 
    Sheets(I).Activate
    Sheets(I).Unprotect Password:="Toto"
 
    For Each s In Sheets(I).Shapes
    s.Placement = xlMoveAndSize
    Next
 
    With Sheets(I).Range("K14:K100")
    Set c = .Find("---", LookIn:=xlValues)
        If Not c Is Nothing Then
        firstAddress = c.Address
        Do
        e = e + 1
        ReDim Preserve tablosupp(1 To e) ' on redimention notre tablo +1 et on ajoute la derniere adresse trouvée
        tablosupp(e) = c.Address
        Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
 
  For a = 1 To UBound(tablosupp)
        If Sheets(I).Range(tablosupp(a)).EntireRow.Hidden = True Then
        Sheets(I).Range(tablosupp(a)).EntireRow.Hidden = False
        Sheets(1).Cells(1, 19) = "NON"
        Sheets(1).CommandButton1.Caption = "Masquer"
        Else
        Sheets(I).Range(tablosupp(a)).EntireRow.Hidden = True
        Sheets(1).Cells(1, 19) = "OUI"
        Sheets(1).CommandButton1.Caption = "Demasquer"
 
        End If
    Next
    End With
Sheets(I).Protect Password:="Toto"
Next
 
Worksheets(1).Activate
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Unload USFwait
End Sub

Quand j'ai procédé à un masquage, enregistrer et fermé le fichier. SI je l'ouvre à nouveau et que je reclique sur le bouton alors j'ai l'erreur d'execution 9 sur cette ligne

Code:

1
2
 
For a = 1 To UBound(tablosupp)

normal me direz vous car le tablosupp est vide...

Comment m'affranchir de ce soucis?

14/05/2013, 16h38
patricktoulon

re

Bonjour
je ne vois pas trop
donne un exemplaire de ton fichier données confidentielles exclu bien entendu

Au plaisir
14/05/2013, 16h55
SfJ5Rpw8
Bonjour,

Citation:

Envoyé par waspy59

...
normal me direz vous car le tablosupp est vide...

Comment m'affranchir de ce soucis?

déplace ton End if (de If Not c Is Nothing...) après le Next de ta boucle
Code:

1 2 For a = 1 To UBound(tablosupp)
14/05/2013, 17h20
patricktoulon

re

bonjour bbil

Je l'avais pas vu celle la lol.....
on devrait bannir le copier coller ca eviterait de faire ce genre d'erreur
tiens encore lol...
Au plaisir