Autres Afficher et masquer des tableaux et des sous tableaux

chaelie2015

XLDnaute Accro
Bonjour Forum
Je souhaite afficher et masquer des tableaux (11 tableaux couleur jaune) et sous tableaux(et 10 tableaux couleur vert) sous condition.
Dans la feuille"Anvers" par défaut toutes les lignes (de 5-430) sont masquées.
en première phase si je fais rentrer dans la cellule C3 une valeur par exemple 4 donc j'aurai que l’entête du tableau (jaune) et 04 tableaux jaune (1 2 3 et 4) et la dernière ligne Total.
en deuxième phase dans les 4 tableaux , si je fais rentrer dans les cellules vertes une valeur, je souhaite afficher le tableau vert selon le nombre saisi.
exemple dans tableau jaune1 dans la cellule X9 j'ai saisi 5 donc j'aurai l’entête du tableau vert et 5 lignes et ainsi de suite.
Merci par avance
NB: désolé pour le fichier joint, c'est une omission
 

Pièces jointes

  • Charlie BTB anvers 2020.xlsx
    73.3 KB · Affichages: 14
Dernière édition:
Solution
Bonjour chaelie2015, danielco,

Voyez le fichier joint et ces macros dans le code de la feuille :
VB:
Dim ligtot& 'mémorise la variable

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i&
If Not Intersect(Target, [C3,P:T]) Is Nothing Then _
    i = ActiveWindow.ScrollRow: Afficher: ActiveWindow.ScrollRow = i
End Sub

Sub Masquer()
Application.ScreenUpdating = False
Rows.Hidden = False
ligtot = [A:B].Find("Total", , xlValues).Row
Rows("9:" & ligtot).Hidden = True
End Sub

Sub Afficher()
Dim nlig&, coul&, c As Range, n&, v&, i&
Masquer
nlig = Val([C3]) 'à adapter
If nlig < 1 Then Exit Sub
coul = [A5].Interior.Color
For Each c In Range("A9:A" & ligtot)
    If c.Interior.Color = coul Then
        c.EntireRow.Hidden = False
        n =...

chaelie2015

XLDnaute Accro
Oups, désolé. Remplace la macro par celle-ci :

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Tabl As Variant, I As Long
  Tabl = Array(1, 9, 51, 93, 135, 177, 219, 261, 303, 345, 367)
  If Target.Address = "$C$3" Then
    Rows("9:429").Hidden = True
    If IsNumeric(Target) Then
      If Target > 0 Then
        For I = 1 To Target
          Rows(Tabl(I)).Hidden = False
        Next I
      End If
    End If
  ElseIf Target.Column = 24 And IsNumeric(Application.Match(Target.Row, Tabl, 0)) Then
    Rows(Target.Row + 1 & ":" & Target.Row + 41).Hidden = True
    Rows(Target.Row + 1 & ":" & Target.Row + Target + 1).Hidden = False
  End If
End Sub

Daniel
Bonjour Daniel
super travail, merci pour la réponse..
mais j'ai trouvé un petit souci. quand les cellules des saisi vertes des sous tableaux sont vide ????
a+
 

danielco

XLDnaute Accro
J'ai complètement oublié la ligne total. C'est ça que tu veux dire ?

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Tabl As Variant, I As Long
  Tabl = Array(1, 9, 51, 93, 135, 177, 219, 261, 303, 345, 367)
  If Target.Address = "$C$3" Then
    Rows("9:429").Hidden = True
    If IsNumeric(Target) Then
      If Target > 0 Then
        For I = 1 To Target
          Rows(Tabl(I)).Hidden = False
        Next I
        Rows(429).Hidden = False
      End If
    End If
  ElseIf Target.Column = 24 And IsNumeric(Application.Match(Target.Row, Tabl, 0)) Then
    Rows(Target.Row + 1 & ":" & Target.Row + 41).Hidden = True
    Rows(Target.Row + 1 & ":" & Target.Row + Target + 1).Hidden = False
    Rows(429).Hidden = False
  End If
End Sub

Daniel
 

danielco

XLDnaute Accro
le code suivant n'agit que si la valeur est numérique, positive ou nulle et inférieure à 41. Faut-il accepter les valeurs nulles ?

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Tabl As Variant, I As Long
  Tabl = Array(1, 9, 51, 93, 135, 177, 219, 261, 303, 345, 367)
  If Target.Address = "$C$3" Then
    Rows("9:429").Hidden = True
    If IsNumeric(Target) Then
      If Target > 0 Then
        For I = 1 To Target
          Rows(Tabl(I)).Hidden = False
        Next I
        Rows(429).Hidden = False
      End If
    End If
  ElseIf Target.Column = 24 And IsNumeric(Application.Match(Target.Row, Tabl, 0)) Then
    If IsNumeric(Target) Then
      If Target >= 0 And Target < 41 Then
        Rows(Target.Row + 1 & ":" & Target.Row + 41).Hidden = True
        Rows(Target.Row + 1 & ":" & Target.Row + Target + 1).Hidden = False
        Rows(429).Hidden = False
      End If
    End If
  End If
End Sub

Daniel
 

job75

XLDnaute Barbatruc
Bonjour chaelie2015, danielco,

Voyez le fichier joint et ces macros dans le code de la feuille :
VB:
Dim ligtot& 'mémorise la variable

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i&
If Not Intersect(Target, [C3,P:T]) Is Nothing Then _
    i = ActiveWindow.ScrollRow: Afficher: ActiveWindow.ScrollRow = i
End Sub

Sub Masquer()
Application.ScreenUpdating = False
Rows.Hidden = False
ligtot = [A:B].Find("Total", , xlValues).Row
Rows("9:" & ligtot).Hidden = True
End Sub

Sub Afficher()
Dim nlig&, coul&, c As Range, n&, v&, i&
Masquer
nlig = Val([C3]) 'à adapter
If nlig < 1 Then Exit Sub
coul = [A5].Interior.Color
For Each c In Range("A9:A" & ligtot)
    If c.Interior.Color = coul Then
        c.EntireRow.Hidden = False
        n = n + 1
        v = Val(c(1, 24)) 'colonne X
        If v > 0 Then
            i = 2
            Do
                c(i).EntireRow.Hidden = False
                i = i + 1
            Loop While i < v + 3 And IsNumeric(c(i))
        End If
        If n = nlig Then Exit For
    End If
Next
Rows(ligtot).Hidden = False
End Sub
Il n'est pas indispensable d'affecter les macros Masquer et Afficher aux boutons.

Le code s'exécute quand on modifie ou valide C3 ou les colonnes P:T.

A+
 

Pièces jointes

  • Charlie BTB anvers 2020(1).xlsm
    83.2 KB · Affichages: 6

Discussions similaires

Statistiques des forums

Discussions
312 098
Messages
2 085 267
Membres
102 845
dernier inscrit
Baticle.geo