Afficher/Masquer des onglets

Le 04/04/2020 à 11:18

Bonjour,

J'ai essayé d'adapter un code que j'ai trouvé pour afficher ou masquer selon une cellule mais cela ne fonctionne pas.

Avez-vous des idées du problème ?

Voici le code :

Private Sub Worksheet_Change(ByVal Target As Range) 'déclencher une action si il y a un changement sur la feuille If Not Intersect(Target, Cells(36, 4)) Is Nothing Then 'Si le changement à lieu dans la cellule D36 (intersection de la ligne 36 et de la colonne 4) If Target = "X" Then 'Si la nouvelle c'est "X" alors LtLabo.Visible = xlSheetVisible 'rendre visible Bord.Labo.Visible = xlSheetVisible 'rendre visible EtLabo.Visible = xlSheetVisible 'rendre visible LaboEurofins.Visible = xlSheetVisible 'rendre visible AM1.Visible = xlSheetVisible 'rendre visible AM2Néant.Visible = xlSheetVisible 'rendre visible AM2tab.Visible = xlSheetVisible 'rendre visible Annexe2.Visible = xlSheetVisible 'rendre visible Annexe3.Visible = xlSheetVisible 'rendre visible Annexe4.Visible = xlSheetVisible 'rendre visible AMconserv.Visible = xlSheetVisible 'rendre visible AMéval.Visible = xlSheetVisible 'rendre visible Else 'sinon LtLabo.Visible = xlSheetHidden 'masquer Bord.Labo.Visible = xlSheetHidden 'masquer EtLabo.Visible = xlSheetHidden 'masquer LaboEurofins.Visible = xlSheetHidden 'masquer AM1.Visible = xlSheetHidden 'masquer AM2Néant.Visible = xlSheetHidden 'masquer AM2tab.Visible = xlSheetHidden 'masquer Annexe2.Visible = xlSheetHidden 'masquer Annexe3.Visible = xlSheetHidden 'masquer Annexe4.Visible = xlSheetHidden 'masquer AMconserv.Visible = xlSheetHidden 'masquer AMéval.Visible = xlSheetHidden 'masquer Feuil2.Visible = xlSheetHidden 'masquer End If 'fin de ma première condition End If 'fin de ma deuxième condition End Sub

Merci d'avance.

Le 04/04/2020 à 11:27

Salut Tony2Mars

Tu dois avoir un message d'erreur lors de l'exécution de ton code

Il faut utiliser l'objet feuille pour les afficher ou masquer

A+

Le 05/04/2020 à 10:27

Bonjour BrunoM45,

Je n'ai pas compris ce que tu veux me dire, je suis pas très doué en VBA.

Je sais même pas pourquoi je ne l'ai pas dans la liste des Exécutions de macro.

Cordialement.

Le 05/04/2020 à 10:50

Re,

Tu ne dois pas faire

LtLabo.Visible = xlSheetVisible

Mais

Sheets("LtLabo").Visible = xlSheetVisible

A+

Le 05/04/2020 à 14:04

Merci Bruno mais j'ai changer le code entièrement et il ne se passe toujours rien quand je met une croix dans la cellule D36 de l'onglet nommé : G.

Private Sub Worksheet_Change(ByVal Target As Range) 'déclencher une action si il y a un changement sur la feuille If Not Intersect(Target, Cells(36, 4)) Is Nothing Then 'Si le changement à lieu dans la cellule D36 (intersection de la ligne 36 et de la colonne 4) If Target = "X" Then 'Si la nouvelle c'est "X" alors Sheets("LtLabo").Visible = xlSheetVisible 'rendre visible Sheets("Bord.Labo").Visible = xlSheetVisible 'rendre visible Sheets("EtLabo").Visible = xlSheetVisible 'rendre visible Sheets("LaboEurofins").Visible = xlSheetVisible 'rendre visible Sheets("AM1").Visible = xlSheetVisible 'rendre visible Sheets("AM2Néant").Visible = xlSheetVisible 'rendre visible Sheets("AM2tab").Visible = xlSheetVisible 'rendre visible Sheets("Annexe2").Visible = xlSheetVisible 'rendre visible Sheets("Annexe3").Visible = xlSheetVisible 'rendre visible Sheets("Annexe4").Visible = xlSheetVisible 'rendre visible Sheets("AMconserv").Visible = xlSheetVisible 'rendre visible Sheets("AMéval").Visible = xlSheetVisible 'rendre visible Else 'sinon Sheets("LtLabo").Visible = xlSheetHidden 'masquer Sheets("Bord.Labo").Visible = xlSheetHidden 'masquer Sheets("EtLabo").Visible = xlSheetHidden 'masquer Sheets("LaboEurofins").Visible = xlSheetHidden 'masquer Sheets("AM1").Visible = xlSheetHidden 'masquer Sheets("AM2Néant").Visible = xlSheetHidden 'masquer Sheets("AM2tab").Visible = xlSheetHidden 'masquer Sheets("Annexe2").Visible = xlSheetHidden 'masquer Sheets("Annexe3").Visible = xlSheetHidden 'masquer Sheets("Annexe4").Visible = xlSheetHidden 'masquer Sheets("AMconserv").Visible = xlSheetHidden 'masquer Sheets("AMéval").Visible = xlSheetHidden 'masquer End If 'fin de ma première condition End If 'fin de ma deuxième condition End Sub

Quelqu'un à une idée ?

Merci d'avance à tous.

Le 05/04/2020 à 15:08

Re,

Ôte moi d'un doute, tu as bien mis

Worksheet_Change

dans l'onglet en question ?

Et si tu mets un point d'arrêt (F9) sur la ligne

If Not Intersect(Target, Cells(36, 4))

Et que tu testes ?

A+

11tony2mars-exemple.xlsm (15.25 Ko)
Le 05/04/2020 à 15:37

Bonjour Tony2mars, BrunoM45, le forum,

Un essai de simplification du code.....(Bruno me corrigera si je dit une ânerie, )

Option Compare Text

Private Sub Worksheet_Change(ByVal Target As Range) 'déclencher une action si il y a un changement sur la feuille
 Dim F, sh As Worksheet

 Application.ScreenUpdating = False

     Set F = Sheets(Array("LtLabo", "Bord.Labo", "EtLabo", "LaboEurofins", "AM1", "AM2Néant", "AM2tab", "Annexe2", "Annexe3", "Annexe4", "AMconserv", "AMéval"))

 If Not Intersect(Target, Cells(36, 4)) Is Nothing Then 'Si le changement à lieu dans la cellule D36 (intersection de la ligne 36 et de la colonne 4)
  For Each sh In F
   Select Case Target.Value
    Case Is = "X"
     sh.Visible = xlSheetVisible 'rendre visible
    Case Else
     sh.Visible = xlSheetHidden 'masquer
    End Select
   Next sh
  End If 'fin de condition
End Sub

Cordialement,

Le 05/04/2020 à 16:52

Salut xorsankukai, heureux de te croiser

C'est presque parfait, mais on peut encore optimisé un chouilla

J'ai mis quelques commentaires pour expliciter le code

Private Sub Worksheet_Change(ByVal Target As Range) 'déclencher une action si il y a un changement sur la feuille
 Dim F, sh As Worksheet
 ' Empêcher le rafrichissement écran
 Application.ScreenUpdating = False
 'Si le changement à lieu dans la cellule D36
 If Not Intersect(Target, Range("D36")) Is Nothing Then
  ' Définir le tableau des feuilles à parcourir
   Set F = Sheets(Array("LtLabo", "Bord.Labo", "EtLabo", "LaboEurofins", "AM1", "AM2Néant", "AM2tab", "Annexe2", "Annexe3", "Annexe4", "AMconserv", "AMéval"))
   ' Pou chaque feuille
   For Each sh In F
    ' Afficher/masquer la feuille selon valeur de la cellule
    sh.Visible = (Target.Value = "X")
   Next sh
   ' Effacer la variable objet pour libérer la mémoire
   Set F = Nothing
  End If
End Sub

Le 05/04/2020 à 17:03

Re,

C'est presque parfait, mais on peut encore optimisé un chouilla

Arrrrgh!!!! J'y étais presque....

Merci pour l'optimisation, , j'en prends bonne note,

Amitiés,

Le 05/04/2020 à 17:33

Bonjour,

Merci beaucoup à tout les deux cela fonctionne très bien. Juste j'aimerai faire cette manipulation pour plusieurs cas et d'autres onglets..

Comment puis je faire ?

Private Sub Worksheet_Change(ByVal Target As Range) 'déclencher une action si il y a un changement sur la feuille Dim F, sh As Worksheet ' Empêcher le rafrichissement écran Application.ScreenUpdating = False 'Si le changement à lieu dans la cellule D36 If Not Intersect(Target, Range("B4")) Is Nothing Then ' Définir le tableau des feuilles à parcourir Set F = Sheets(Array("LtLabo", "Bord.Labo", "EtLabo", "LaboEurofins", "AM1", "AM2Néant", "AM2tabl", "Annexe2", "Annexe3", "Annexe4", "AMconserv", "AMéval")) ' Pou chaque feuille For Each sh In F ' Afficher/masquer la feuille selon valeur de la cellule sh.Visible = (Target.Value = "X") Next sh Application.ScreenUpdating = False If Not Intersect(Target, Range("B5")) Is Nothing Then ' Définir le tableau des feuilles à parcourir Set F = Sheets(Array("EP")) ' Pou chaque feuille For Each sh In F ' Afficher/masquer la feuille selon valeur de la cellule sh.Visible = (Target.Value = "X") Next sh Application.ScreenUpdating = False If Not Intersect(Target, Range("B6")) Is Nothing Then ' Définir le tableau des feuilles à parcourir Set F = Sheets(Array("LC", "MESURAGE", "LB")) ' Pou chaque feuille For Each sh In F ' Afficher/masquer la feuille selon valeur de la cellule sh.Visible = (Target.Value = "X") Next sh Application.ScreenUpdating = False If Not Intersect(Target, Range("B7")) Is Nothing Then ' Définir le tableau des feuilles à parcourir Set F = Sheets(Array("PB", "TabPBfin", "%", "NI")) ' Pou chaque feuille For Each sh In F ' Afficher/masquer la feuille selon valeur de la cellule sh.Visible = (Target.Value = "X") Next sh Application.ScreenUpdating = False If Not Intersect(Target, Range("B9")) Is Nothing Then ' Définir le tableau des feuilles à parcourir Set F = Sheets(Array("fichTer gaz", "GAZ", "FICHE INFO", "LEVEE DGI")) ' Pou chaque feuille For Each sh In F ' Afficher/masquer la feuille selon valeur de la cellule sh.Visible = (Target.Value = "X") Next sh Application.ScreenUpdating = False If Not Intersect(Target, Range("B10")) Is Nothing Then ' Définir le tableau des feuilles à parcourir Set F = Sheets(Array("fichTer élec", "ELEC")) ' Pou chaque feuille For Each sh In F ' Afficher/masquer la feuille selon valeur de la cellule sh.Visible = (Target.Value = "X") Next sh End If End If End If End If End If End If End Sub

J'ai mon collaborateur qui m'a envoyé ça mais cela ne fonctionne pas.. Bon en même temps, je crois qu'il est encore moins bon que moi en VBA !

Merci d'avance.

Le 05/04/2020 à 17:51

Re,

Outche... ça pique

Voici un code possible en utilisant Select Case... End Select 

Private Sub Worksheet_Change(ByVal Target As Range) 'déclencher une action si il y a un changement sur la feuille
  Dim F, sh As Worksheet
  ' Vérifier si la saisie c'est faite dans une des cellules souhaitée, sinon on sort
  If Intersect(Range("B4:B7,B9:B10"), Target) Is Nothing Then Exit Sub
  ' Empêcher le rafrichissement écran
  Application.ScreenUpdating = False
  ' En cas d'erreur
  ' Utilisation du Select Case
  Select Case Target.Address
    ' Définir le tableau des feuilles à parcourir
    Case "$B$4"
      Set F = Sheets(Array("LtLabo", "Bord.Labo", "EtLabo", "LaboEurofins", "AM1", "AM2Néant", "AM2tabl", "Annexe2", "Annexe3", "Annexe4", "AMconserv", "AMéval"))
    Case "$B$5"
      Set F = Sheets(Array("EP"))
    Case "$B$6"
      Set F = Sheets(Array("LC", "MESURAGE", "LB"))
    Case "$B$7"
      Set F = Sheets(Array("PB", "TabPBfin", "%", "NI"))
    Case "$B$9"
      Set F = Sheets(Array("fichTer gaz", "GAZ", "FICHE INFO", "LEVEE DGI"))
    Case "$B$10"
      Set F = Sheets(Array("fichTer élec", "ELEC"))
  End Select
  ' Pour chaque feuille définit dans le Tableau de feuille
  For Each sh In F
    ' Afficher/masquer la feuille si la valeur de la cellule = "X"
    sh.Visible = (Target.Value = "X")
  Next sh
  ' Réactiver le rafraichissement
  Application.ScreenUpdating = True
  ' Effacer la variable objet pour libérer la mémoire
  Set F = Nothing
End Sub

Edit : code modifié pour éviter les erreurs en cas de saisie en dehors de cellules souhaitées

A+

Le 05/04/2020 à 18:02

Merci Bruno cela marche parfaitement. La dernière chose, c'est que si je fais une "'X" ailleurs sur l'onglet, j'ai un message d'erreur.

Il me surligne en jaune : For Each sh In F

Tu es au top Bruno en tout cas merci pour tes réponses !

Le 05/04/2020 à 18:08

Merci Bruno cela marche parfaitement. La dernière chose, c'est que si je fais une "'X" ailleurs qu'en B4, B5 etc sur l'onglet, j'ai un message d'erreur.

Erreur : Objet requis

Il me surligne en jaune : For Each sh In F

Tu es au top Bruno en tout cas merci pour tes réponses rapide !

Le 05/04/2020 à 18:15

Re,

Effectivement, je n'avais pas testé toutes les éventualités

Code de mon précédent post modifié pour en tenir compte

Le 05/04/2020 à 18:18

Lol merci Bruno mais du coup ça ne marche plus

Le 05/04/2020 à 18:23

Désolé

Code re-modifié, il faut supprimé le 2ème test... trop de tests tuent le test

Le 05/04/2020 à 19:11

Merci beaucoup Bruno tu m'as été d'une grande aide ! Je peux dire que le Post les Clos maintenant lol.

Rechercher des sujets similaires à "afficher masquer onglets"