Microsoft 365 Code VBA pour vérifier si lignes masquées le sont bien

[PatFr38]

Bonjour, à toutes et à tous.

J'aurais besoin d'un code VBA pour simplifier celui que j'ai déjà, qui prend beaucoup de temps à chaque activation de l'onglet concerné (Programme).

Quand j'active l'onglet Programme, mon code (voir l'actuel ci-dessous, qui fonctionne très bien, mais est très long en temps de traitement à chaque activation/consultation de l'onglet) doit vérifier si dans un autre onglet, nommé BDD (Base De Données), un nom d'équipe a été saisi et des noms d'Agents de cette équipe. Si aucun nom d'équipe et/ou d'Agents n'a été saisi en BDD, les lignes concernées sont masquées dans l'onglet Programme. Ce code a pour autre rôle de masquer les lignes de détails de chaque Agent, qui auraient été laissées visibles après affichage par un bouton (tout cela fonctionne très bien, là n'est pas le souci) lors de la dernière activation de cet onglet Programme. Une idée, SVP ? Merci d'avance.

Private Sub Worksheet_Activate()
' Automatismes à l'ouverture de l'onglet

' Déprotège l'onglet
    ActiveSheet.Unprotect

' Masque les lignes vides des Equipes et Agents non saisis en BDD, et les détails des Agents
' Equipe 01
' Nom Equipe 01
If Sheets("BDD").Range("F3") = 0 Then
    Rows("5").EntireRow.Hidden = True
    Else
    Rows("5").EntireRow.Hidden = False
End If
' Agent 01 de l'Equipe 01
If Sheets("BDD").Range("H4") = 0 Then
    Rows("6:13").EntireRow.Hidden = True
    Else
    Rows("6:13").EntireRow.Hidden = False
    Rows("7:12").EntireRow.Hidden = True
End If
' Agent 02 de la Brigade 01
If Sheets("BDD").Range("H5") = 0 Then
    Rows("14:21").EntireRow.Hidden = True
    Else
    Rows("14:21").EntireRow.Hidden = False
    Rows("15:20").EntireRow.Hidden = True
End If

' Il y a ainsi au total 7 Equipes de 10 Agents chacune!

' Sélectionne la liste déroulante des mois
    Range("A4").Select

' Reprotège l'onglet
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

 

[Phil69970]

Bonjour @PatFr38

Avec un fichier c'est mieux ......

 

[TooFatBoy]

Bonjour,

Effectivement , Phil69970 a raison, avec un fichier anonymisé, ce serait mieux.

Mais essaye déjà de mettre, au tout début de ta macro, l'instruction suivante :

Application.ScreenUpdating=Fale

Et dis-nous si ta macro est alors un peu moins lente.

 

[PatFr38]

Bonjour.

MERCI, TooFatBoy ! Je viens de tester ta solution, qui est... magique ! fantastique ! Bravo, c'est super, l'affichage est instantané, c'est le jour et la nuit ! Impeccable, exactement ce qu'il me fallait.

Bonne fin de semaine. Ciao.

 

[Phil69970]

Re

Bonjour TFB

@PatFr38

Au vu de ton code et avec un fichier il y a surement largement de quoi faire encore mieux

Rows("6:13").EntireRow.Hidden = False
Rows("7:12").EntireRow.Hidden = True

Car franchement afficher puis cacher dans la foulée les 3/4 des lignes que l'ont vient d'afficher il y a plus court je pense ....

Ou c'est aimer se promener

 

[PatFr38]

Bonjour, Phil.
Merci pour ton analyse et ta suggestion d'amélioration, sur laquelle je vais me pencher.

 

[TooFatBoy]

En plus de l'instruction qui bloque le rafraîchissement visuel de la feuille je pense, tout comme Phil69970, qu'on doit également pouvoir optimiser le code, ce qui ferait gagner encore plus de temps.

 

[Phil69970]

Re

Et c'est pour cela que l'on demande le fichier c'est bien pour avoir une vision d'ensemble.....

 

[PatFr38]

OK, alors voici mon fichier exemple, si cela peut aider à améliorer le code. Je lui ai intégré la solution de TFB.

Bonne soirée.

 

[TooFatBoy]

Dans ta macro Worksheet_Activate je te propose de traiter le masquage/affichage de toutes les lignes du tableau, en utilisant deux boucles imbriquées (une pour les 7 équipes et l'autre pour les 10 agents de chaque équipe) :

Dim NumEquipe As Integer, NumAgent As Integer

    ' Masque les lignes vides des Equipes et Agents non saisis en BDD, et les détails des Agents laissés ouverts lors de la dernière consultation de l'onglet
    For NumEquipe = 1 To 7      ' Equipe 01 à Equipe 07

        Rows("5").Offset(81 * NumEquipe - 81).EntireRow.Hidden = (Sheets("BDD").Range("F3").Offset(NumEquipe - 1) = "")

        For NumAgent = 1 To 10  ' Agent 01 à 10 de l'Equipe
            If Sheets("BDD").Range("H4").Offset(11 * NumEquipe + NumAgent - 12) = "" Then
                Rows("6:13").Offset(81 * NumEquipe + 8 * NumAgent - 89).EntireRow.Hidden = True
            Else
                Rows("6").Offset(81 * NumEquipe + 8 * NumAgent - 89).EntireRow.Hidden = False
                Rows("7:12").Offset(81 * NumEquipe + 8 * NumAgent - 89).EntireRow.Hidden = True
                Rows("13").Offset(81 * NumEquipe + 8 * NumAgent - 89).EntireRow.Hidden = False
            End If
        Next NumAgent

    Next NumEquipe

 

[Phil69970]

Re

TFB

J'ai commencé à regarder puis j'ai fait autre chose dans la maison mais c'est exactement la voie que j'aurais prise.

Effectivement il y a un pas de 11 et un autre de 81 entre touts les "if" et "end if"

 

[TooFatBoy]

Merci Phil69970

Si tu veux, tu peux lui faire "la même chose" pour sa macro Worksheet_SelectionChange, moi je n'ai pas trop le courage pour l'instant.

 

[Phil69970]

Re

Si tu veux, tu peux lui faire "la même chose"

Ma version de Worksheet_SelectionChange
1 000 lignes avant ==> - de 20 lignes maintenant pas mal non !

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim tablo, tablo1, Lig&
 
tablo = Array(12, 20, 28, 36, 44, 52, 60, 68, 76, 84, 93, 101, 109, 117, 125, 133, 141, 149, 157, 165, 174, 182, 190, _
198, 206, 214, 222, 230, 238, 246, 255, 263, 271, 279, 287, 295, 303, 311, 319, 327, 336, 344, 352, 360, 368, 376, 384, _
392, 400, 408, 417, 425, 433, 441, 449, 457, 465, 473, 481, 489, 498, 506, 514, 522, 530, 538, 546, 554, 562, 570)

tablo1 = Array(6, 14, 22, 30, 38, 46, 54, 62, 70, 78, 87, 95, 103, 111, 119, 127, 135, 143, 151, 159, 168, 176, 184, _
192, 200, 208, 216, 224, 232, 240, 249, 257, 265, 273, 281, 289, 297, 305, 313, 321, 330, 338, 346, 354, 362, 370, 378, _
386, 394, 402, 411, 419, 427, 435, 443, 451, 459, 467, 475, 483, 492, 500, 508, 516, 524, 532, 540, 548, 556, 564)

ActiveSheet.Unprotect
Lig = Target.Row
Application.EnableEvents = False
If Not IsError(Application.Match(Lig, tablo, 0)) = "Vrai" Then Rows(Lig - 5 & ":" & Lig).EntireRow.Hidden = True                  'Masque
If Not IsError(Application.Match(Lig, tablo1, 0)) = "Vrai" Then Rows(Lig + 1 & ":" & Lig + 6).EntireRow.Hidden = False            'Visible

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Range("A4").Select
Application.EnableEvents = True
End Sub

Au demandeur de remplacer tout ça et gagner en fluidité (les 2 macros Worksheet_Activate et Worksheet_SelectionChange )

 

[PatFr38]

Bonjour.

Un grand MERCI à TooFatBoy et à Phil69970 pour le temps que vous avez accordé à mon projet et pour vos nouveaux codes, qui sont bien plus courts, rapides et donc efficaces ; bravo, mon respect et ma reconnaissance à vous deux pour votre talent de codeur. Dire que mon fils est parti pour 3 années d'étude pour devenir programmeur... Je pourrais l'impliquer dans mon projet, cela lui ferait un bon exercice.

Bon week-end à tous.

P.S. : Vous allez sans doute trouver plus tard d'autres appels à l'aide de ma part pour ce projet, car il me reste encore des onglets à créer, qui interfèreront avec cet onglet principal Programme.

 

[PatFr38]

Re



Ma version de Worksheet_SelectionChange
1 000 lignes avant ==> - de 20 lignes maintenant pas mal non !

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim tablo, tablo1, Lig&
 
tablo = Array(12, 20, 28, 36, 44, 52, 60, 68, 76, 84, 93, 101, 109, 117, 125, 133, 141, 149, 157, 165, 174, 182, 190, _
198, 206, 214, 222, 230, 238, 246, 255, 263, 271, 279, 287, 295, 303, 311, 319, 327, 336, 344, 352, 360, 368, 376, 384, _
392, 400, 408, 417, 425, 433, 441, 449, 457, 465, 473, 481, 489, 498, 506, 514, 522, 530, 538, 546, 554, 562, 570)

tablo1 = Array(6, 14, 22, 30, 38, 46, 54, 62, 70, 78, 87, 95, 103, 111, 119, 127, 135, 143, 151, 159, 168, 176, 184, _
192, 200, 208, 216, 224, 232, 240, 249, 257, 265, 273, 281, 289, 297, 305, 313, 321, 330, 338, 346, 354, 362, 370, 378, _
386, 394, 402, 411, 419, 427, 435, 443, 451, 459, 467, 475, 483, 492, 500, 508, 516, 524, 532, 540, 548, 556, 564)

ActiveSheet.Unprotect
Lig = Target.Row
Application.EnableEvents = False
If Not IsError(Application.Match(Lig, tablo, 0)) = "Vrai" Then Rows(Lig - 5 & ":" & Lig).EntireRow.Hidden = True                  'Masque
If Not IsError(Application.Match(Lig, tablo1, 0)) = "Vrai" Then Rows(Lig + 1 & ":" & Lig + 6).EntireRow.Hidden = False            'Visible

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Range("A4").Select
Application.EnableEvents = True
End Sub

Au demandeur de remplacer tout ça et gagner en fluidité (les 2 macros Worksheet_Activate et Worksheet_SelectionChange )

Après avoir intégré le code de TooFatBoy dans Worksheet_Activate à la place de mon ancien code, tout fonctionnait bien, mais après avoir intégré ton code dans Worksheet_SelectionChange, un problème est apparu, désolé... En effet, quand je clique sur mon bouton à bascule Menu, à la place d'afficher/masquer mon Menu qui est sur la ligne 3, c'est la ligne 4 en-dessous qui est affichée/masquée... Je suppose que cela provient des Array des "tablo" ou de "Lig"... Je joins mon fichier exemple mis à jour avec les nouveaux codes.