Masquer des colonnes en fonction de la couleur d'une cellule

Le 22/11/2022 à 17:48
15dpgf-essai-macro.zip (266.41 Ko)

Bonjour,

Je cherche à créer un objet active X, une case à cocher pour afficher / masquer des colonnes et des lignes.

J'ai un code couleur répété en x et en y (pas de MFC) et il me faut masquer les lignes dont la première cellule est rouge et en même temps masquer les colonnes dont la 2e cellule est rouge. Ce qui me permet de masquer tout ce qui a rapport à une localisation données. Je ferrais ensuite pareil avec mes autres localisations.

Ma case fonctionne à cocher fonctionne très bien pour les lignes, mais pour les colonnes, impossible de trouver le bon code, quelqu'un pourrait m'aider s'il vous plait ?

Merci d'avance,

Marie Paule.

Le 22/11/2022 à 22:00

Bonsoir à tous!

Crochemore...pas certain d'avoir compris ta demande ?

Private Sub CheckBox1_Click()
Dim c As Variant
Application.ScreenUpdating = False
For Each c In Range("A3:DK600")
If CheckBox1.Value = True Then
If c.Interior.ColorIndex = 3 Then
c.Rows.Hidden = True
c.Columns.Hidden = True
End If
End If
If CheckBox1.Value = False Then
If c.Interior.ColorIndex = 3 Then
c.Rows.Hidden = False
c.Columns.Hidden = False
End If
End If
Next c
Application.ScreenUpdating = True
End Sub

PS: Les cellules fusionnées ce n'est pas très bon pour du code VBA

Bonne soirée!

Le 22/11/2022 à 22:50

bonjour,

Private Sub CheckBox1_Click()
     Dim c0, c, UN As Range
     Set c = Me.UsedRange

     If CheckBox1.Value Then

          Application.FindFormat.Clear     'RAZ findformat
          Application.FindFormat.Interior.Color = RGB(192, 0, 0)     'on cherche ce couleur

          For Each c0 In c.Columns(1).Cells     'boucle toutes les cellules de la colonne 1
               Set c1 = c0.EntireRow.Find(What:="", SearchOrder:=xlByRows, SearchDirection:=xlNext, searchformat:=True)     'cherchez ce couleur dans ligne X
               If Not c1 Is Nothing Then     'couleur trouvé !!
                    If UN Is Nothing Then Set UN = c1 Else Set UN = Union(UN, c1)     'toutes ces cellules avec ce couleur dans leur ligne
               End If
          Next
          If Not UN Is Nothing Then
     'Debug.Print UN.Address
               UN.EntireRow.Hidden = CheckBox1.Value     'dépendant du checkbox, montrer ou cacher les lignes
          End If

          Set UN = Nothing
          For Each c0 In c.Rows(1).Cells
               Set c1 = c0.EntireColumn.Find(What:="", SearchOrder:=xlByRows, SearchDirection:=xlNext, searchformat:=True)
               If Not c1 Is Nothing Then
                    If UN Is Nothing Then Set UN = c1 Else Set UN = Union(UN, c1)
               End If
          Next
          If Not UN Is Nothing Then UN.EntireColumn.Hidden = CheckBox1.Value

    Else
          c.EntireRow.Hidden = False
          c.EntireColumn.Hidden = False
     End If
End Sub
19dpgf-essai-macro.zip (264.44 Ko)
Le 23/11/2022 à 11:12

Bonjour à tous et mille merci !!!!

Les deux codes fonctionnent nickel ! Le soucis c'est que les colonnes de A à F ne doivent pas se masquer... car se sont mes intitulés et j'en ai besoin pour les localisations qui restent apparentes.

Alors j'ai ajouter les lignes au code de Nordik_Nation :

Columns(1).EntireColumn.Hidden = False
Columns(2).EntireColumn.Hidden = False
Columns(3).EntireColumn.Hidden = False

je pense qu'il y a plus simple mais ça fonctionne...

Maintenant que j'ai réussi cela, j'aimerais masquer plusieurs "couleur" (donc localisations), est-ce que je dois juste répéter le code plusieurs fois en changeant le code couleur ou bien est-ce que je peux faire plus simple ?

D'avance merci !

Marie Paule

Le 23/11/2022 à 12:00

bonjour, une petite adaptation pour ces cellules

Private Sub CheckBox1_Click()
     Dim c0, c, UN As Range
     Set c = Me.UsedRange     'les cellules utilisées

     If CheckBox1.Value Then     'MASQUER

          Application.FindFormat.Clear     'RAZ findformat
          Application.FindFormat.Interior.Color = RGB(192, 0, 0)     'on cherche ce couleur

          For i = c.Row To c.Row + c.Rows.Count - 1     'boucle toutes les cellules de la colonne 1
               Set c1 = Me.Range(Cells(i, "G"), Cells(i, "XFD")).Find(What:="", SearchOrder:=xlByRows, SearchDirection:=xlNext, searchformat:=True)     'cherchez ce couleur dans ligne X,sauf cellules A:F
               If Not c1 Is Nothing Then     'couleur trouvé !!
                    If UN Is Nothing Then Set UN = c1 Else Set UN = Union(UN, c1)     'toutes ces cellules avec ce couleur dans leur ligne
               End If
          Next
          If Not UN Is Nothing Then
               UN.EntireRow.Hidden = CheckBox1.Value     'dépendant du checkbox, montrer ou cacher les lignes
          End If

          Set UN = Nothing
          For Each c0 In Me.Range(Cells(i, "G"), Cells(i, "XFD")).Cells     'boucle toutes les cellules de la première ligne, sauf A:F
               Set c1 = c0.EntireColumn.Find(What:="", SearchOrder:=xlByRows, SearchDirection:=xlNext, searchformat:=True)
               If Not c1 Is Nothing Then
                    If UN Is Nothing Then Set UN = c1 Else Set UN = Union(UN, c1)
               End If
          Next
          If Not UN Is Nothing Then UN.EntireColumn.Hidden = CheckBox1.Value

     Else     'NE PAS MASQUER
          c.EntireRow.Hidden = False
          c.EntireColumn.Hidden = False
     End If
End Sub
Le 23/11/2022 à 13:20

Merci encore pour ce travail, cependant j'ai du mal m'expliquer... Il me faut tout de même chercher le rouge dans les colonnes A à F et masquer les lignes dont qui ont du rouge dedans.

En fait je vais essayer de simplifier / clarifier mon souhait :

1. il faudrait chercher le rouge + une autre couleur dans les cellules de la colonne A et masquer les lignes qui ont ces couleurs en colonne A

2. il faudrait chercher le rouge + une autre couleur dans les cellules de la ligne 2 et masquer les colonnes qui ont ces couleurs en ligne 2

Je crois que cela ferrait un code plus clair et un temps de de calcul moins long...

Est-ce que vous pourriez m'aider a faire ça ? J'ai du mal avec la définition de zone de recherche et zone d'application...

Et d'autre pas j'ai besoin de faire cela dans tous mes onglets ! (une dizaine)

Merci d'avance !

Le 23/11/2022 à 15:00

bonjour,

alors il faut ajouter une case à cocher dans chaque feuille est puis une macro "Sub CheckBox1_Click()" dans chaque module de feuille.

14dpgf-essai-macro.zip (269.10 Ko)
Le 23/11/2022 à 16:33

Bonjour à tous!

Crochemore, en reprenant ma pensée comme ceci peut-être...le code couleur RGB(192,0,0) représente le code couleur rouge de la cellule "C1" et RGB(0,176,80) représente le vert des colonnes "L,M,N,O"

PS: Les colonnes "DH,DI,DJ,DK" seront masquées aussi avec la couleur rouge

vois si cela te convient

Private Sub CheckBox1_Click()
Dim c As Variant
Application.ScreenUpdating = False
For Each c In Range("A3:DK600")
If CheckBox1.Value = True Then
If c.Interior.Color = RGB(192, 0, 0) Or c.Interior.Color = RGB(0, 176, 80) Then
c.Rows.Hidden = True
c.Columns.Hidden = True
Columns(1).Hidden = False
Columns(2).Hidden = False
Columns(3).Hidden = False
Columns(4).Hidden = False
Columns(5).Hidden = False
Columns(6).Hidden = False
End If
End If

If CheckBox1.Value = False Then
If c.Interior.Color = RGB(192, 0, 0) Or c.Interior.Color = RGB(0, 176, 80) Then
c.Rows.Hidden = False
c.Columns.Hidden = False
End If
End If
Next c
Application.ScreenUpdating = True
End Sub
7dpgf-essai-macro.zip (256.65 Ko)
Le 23/11/2022 à 19:43

Bonjour à tous!

Crochemore, une autre approche avec 2 CheckBox pour Lignes et Colonnes avec choix des couleurs intérieures dans les cellules "C1 & D1"

Personnellement je trouve ce fichier plus facile pour sélectionner les couleurs de lignes ou colonnes

Bonne continuation !

4crochemore.zip (260.14 Ko)
Le 23/11/2022 à 20:23

@Nordik_Nation,

si vous groupez ces cellules et masquez les colonnes en une fois, votre code sera 4 fois plus vite.

Private Sub CheckBox2_Click()
     Dim c As Variant, UN As Range
     t = Timer
     Application.ScreenUpdating = False
     For Each c In Range("G2:DK600")
          If CheckBox2.Value = True Then
               If c.Interior.Color = Cells(1, 4).Interior.Color Then
                    If UN Is Nothing Then Set UN = c Else Set UN = Union(UN, c) 'grouper
                    'c.Columns.Hidden = True
               End If
          End If
          If CheckBox2.Value = False Then
               If c.Interior.Color = Cells(1, 4).Interior.Color Then
                    c.Columns.Hidden = False
               End If
          End If
     Next c
     If Not UN Is Nothing Then UN.EntireColumn.Hidden = True'en une fois
     Application.ScreenUpdating = True
     MsgBox Timer - t
End Sub
Le 23/11/2022 à 22:18

Bonsoir à tous!

Crochemore ton fichier en retour version finale en collaboration avec les trucs de l'excellent membre BsAlv que je salue, tu devrais être capable maintenant de masquer ou afficher ce que tu veux avec les couleurs tout est automatisé.

Bonne soirée!

Merci encore BsAlv pour tes astuces !

14crochemore.zip (263.13 Ko)
Le 23/11/2022 à 23:14

Bonsoir,

Merci beaucoup à tous les deux !!! C'est génial j'ai réussi a faire exactement ce que je voulais sur mon tableau complet !!

Excel est magique !!!

Merci et bonne nuit !

Le 24/11/2022 à 00:22

bonsoir,

Est-ce que vous avez vu mon poste de 15:00. Ma macro cherche active les couleurs ou lieu de boucler. Donc normallement, elle est encore plus vite.

Le 24/11/2022 à 15:08

Bonjour à tous!

@BsAlv,

oui j'ai vu votre post et dans le dernier fichier envoyé j'ai intégré votre macro

Bonne journée!

Rechercher des sujets similaires à "masquer colonnes fonction couleur"