affichage/masquages imbriqués(RÉSOLU)

[chaelie2015]

Bonsoir

J’ai 5 tableaux tab1 (21-75), tab2 (77-131), tab3 (133-187), tab4 (189-213), tab5 (245-299) chaque tableau est géré par une cellule pour afficher ou masquer ces lignes (cellules respectivement : L23, L79, L135 L191,L247)

Je souhaite un code VBA pour faire affichage/masquage imbriqué des tableaux

exemple :

si M5 = 1 alors masquer de tab2 au tab5 (ça c’est simple) mais

si M5 = 2 alors masquer tab3 au tab5 mais les deux tab 1 et 2 sont géré par ces L23, L79 pour afficher ou masquer leurs lignes

et ainsi de suite pour M5= 3 , 4 , 5

Salutations

 

[job75]

Bonjour chaelie201, le forum,

Private Sub Worksheet_Change(ByVal R As Range)
Select Case R.Address
   Case [M5].Address
      Rows("6:10").Hidden = 1
      Rows("14:18").Hidden = 1
      Rows("5:" & R + 5).Hidden = 0
      Rows("13:" & R + 13).Hidden = 0
      [L79] = [L79]: [L135] = [L135]: [L191] = [L191]: [L247] = [L247]
   Case [L23].Address
      Rows("25:74").Hidden = 1
      Rows("24:" & R + 24).Hidden = 0
   Case [L79].Address
      Rows("81:130").Hidden = 1
      If [M5] > 1 Then Rows("80:" & R + 80).Hidden = 0
   Case [L135].Address
      Rows("137:186").Hidden = 1
      If [M5] > 2 Then Rows("136:" & R + 136).Hidden = 0
   Case [L191].Address
      Rows("193:242").Hidden = 1
      If [M5] > 3 Then Rows("192:" & R + 192).Hidden = 0
    Case [L247].Address
      Rows("249:298").Hidden = 1
      If [M5] > 4 Then Rows("248:" & R + 248).Hidden = 0
End Select
End Sub

Bonne journée.

 

[chaelie2015]

Bonjour JOB
Merci pour la réponse, apres un test, est ce que il y a la possibilité de masquer les tableaux selon le cas.
je m'explique : si M1=1 Alors masquer tous les tableaux de la ligne 77 a 299
si M1=2 alors masquer les tableaux de la ligne 133 à 299
etc.....
merci par avance

 

[job75]

Re,

Ceci est plus simple et nettement meilleur en cas d'entrées ou effacements multiples :

Private Sub Worksheet_Change(ByVal R As Range)
Set R = Intersect(R, [M5,L23,L79,L135,L191,L247])
If R Is Nothing Then Exit Sub
For Each R In R 'si entrées/effacements multiples
    If R.Row = 5 Then
        Rows("6:10").Hidden = 1
        Rows("14:18").Hidden = 1
        Rows("5:" & R + 5).Hidden = 0
        Rows("13:" & R + 13).Hidden = 0
        [L79] = [L79]: [L135] = [L135]: [L191] = [L191]: [L247] = [L247]
    Else
        Rows(R.Row + 2 & ":" & R.Row + 51).Hidden = 1
        If [M5] > Int((R.Row - 23) / 56) Then Rows(R.Row + 1 & ":" & R + R.Row + 1).Hidden = 0
    End If
Next
End Sub

A+

 

[job75]

Re,

Si l'on veut aussi masquer les lignes au-dessus des tableaux :

Private Sub Worksheet_Change(ByVal R As Range)
Set R = Intersect(R, [M5,L23,L79,L135,L191,L247])
If R Is Nothing Then Exit Sub
For Each R In R 'si entrées/effacements multiples
    If R.Row = 5 Then
        Rows("6:10").Hidden = True
        Rows("14:18").Hidden = True
        Rows("5:" & R + 5).Hidden = False
        Rows("13:" & R + 13).Hidden = False
        [L79] = [L79]: [L135] = [L135]: [L191] = [L191]: [L247] = [L247]
    Else
        Rows(R.Row - 3 & ":" & R.Row + 52).Hidden = True
        If [M5] > Int((R.Row - 23) / 56) Then
            Rows(R.Row - 3 & ":" & R + R.Row + 1).Hidden = False
            Rows(R.Row + 52).Hidden = False
        End If
    End If
Next
End Sub

Nota : j'utilise True et False qui ne pèsent chacun qu'un octet alors que 1 et 0 pèsent 2 octets...

A+

 

[chaelie2015]

Bonjour JOB
Super .... merci pour la réponse
SOUCI RÉSOLU
A+