Faire un code un peu moins long

[lechti31]

Bonjour,
J'aimerai rendre mon code VBA un peu moins long

J'ai un classeur avec 39 feuilles
sur la premiere j'ai 38 boutons qui appellent chacun une feuille
A chaque fois que j'appuis sur un bouton une feuille s'ouvre et ferme automatiquement les autres
une partie de mon code est le suivant

Sub Journée1()
Sheets("J1").Visible = True
Sheets("Accueil").Visible = False
Sheets("J1").Select
Sheets("J1").Activate
Range("A1").Select
End Sub
Sub Journée2()
Sheets("J2").Visible = True
Sheets("Accueil").Visible = False
Sheets("J2").Select
Sheets("J2").Activate
Range("A1").Select
End Sub
Sub Journée3()
Sheets("J3").Visible = True
Sheets("Accueil").Visible = False
Sheets("J3").Select
Sheets("J3").Activate
Range("A1").Select
End Sub
Sub Journée4()
Sheets("J4").Visible = True
Sheets("Accueil").Visible = False
Sheets("J4").Select
Sheets("J4").Activate
Range("A1").Select
End Sub
Sub Journée5()
Sheets("J5").Visible = True
Sheets("Accueil").Visible = False
Sheets("J5").Select
Sheets("J5").Activate
Range("A1").Select
End Sub

J'aimerai au lieu d'ecrire 38 fois les memes lignes l'ecrire qu'une seule fois avec une variable
du style

Sheets("J" & A). Visible = True
Sheets("Accueil").Visible = False
Sheets("J" & A).Select
Sheets("J" & A).Activate
Range("A1").Select

Donc en cliquant sur le bouton 1
A=1 et la feuille J1 s'ouvre

en cliquant sur le bouton 2
A=2 et la feuille J2 s'ouvre

J'ai cherché mais je ne trouve pas mon bonheur
Merci de votre aide

 

[mapomme]

Re : Faire un code un peu moins long

Bonsoir lechti31,

Comme aucun fichier n'est fourni, je me suis autorisé à faire une interprétation libre

Les boutons sont simulés au moyen de cellules formatées avec les bordures idoines.

• Pour afficher une feuille de type Jnn à partir de la feuille "Accueil", cliquer-droit sur la cellule nn.
• Pour afficher toutes les feuilles, cliquer-droit sur les cellules "Afficher tout".
• Lorsqu'on se trouve sur une feuille de type Jnn, revenir à la feuille accueil se fait en tapant la combinaison de touche Ctrl+j.

NOTA: Préférez le fichier v2 du post #7 qui corrige un bug quand on fait Ctrl+j sur la feuille Accueil.

Le code dans le module de la feuille "Accueil" est:

Option Explicit
Const NbrJ = 38

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim i&
  Application.ScreenUpdating = False
  If Not Intersect(Target, Range("F7:P19")) Is Nothing Then
    If Target.Count = 1 Then
      If Target.Value >= 1 And Target.Value <= NbrJ Then
        For i = 1 To Sheets.Count
          If Sheets(i).Name <> Feuil1.Name And Sheets(i).Name <> "J" & Target.Value Then
            Sheets(i).Visible = False
          Else
            Sheets(i).Visible = True
            Application.Goto Sheets(i).Range("A1"), True
          End If
        Next i
        Feuil1.Visible = False
        Cancel = True
      End If
    End If
  ElseIf Not Intersect(Target, Range("N21:P21")) Is Nothing Then
    Cancel = True
    For i = 1 To Sheets.Count
      Sheets(i).Visible = True
    Next i
    Application.Goto Feuil1.Range("A1"), True
  End If
  Application.ScreenUpdating = True
End Sub

Sub Accueil()
'
' A lancer par Ctrl+j
'
  Feuil1.Visible = True
  ActiveSheet.Visible = False
End Sub

 

[lechti31]

Re : Faire un code un peu moins long

Bonsoir Mapomme
Merci pour ton aide mais je ne peux pas ouvrir ton fichier

 

[mapomme]

Re : Faire un code un peu moins long

(re) lechti31,

(...) mais je ne peux pas ouvrir ton fichier (...)

Fichtre! Diantre!

Et que dit Excel quand tu tentes d'ouvrir le fichier ?

J'ai remis le fichier. Est ce la même chose ?

Question: D'autres ont ils la même incapacité à ouvrir le fichier v1 du post #2 et/ou le fichier v1.1 de ce post #4 ? D'avance merci...

NOTA: Préférez le fichier v2 du post #7 qui corrige un bug quand on fait Ctrl+j sur la feuille Accueil.

 

[ROGER2327]

Re : Faire un code un peu moins long

Bonsoir lechti31, mapomme.

À mapomme : Votre fichier s'ouvre sans problème chez moi.
Joli résultat !

Juste une suggestion pour éviter des ennuis avec un Ctrl j exécuté au mauvais endroit :​

Sub Accueil()
'
' A lancer par Ctrl+j
'
  Feuil1.Visible = True
  ActiveSheet.Visible = ActiveSheet.CodeName = "Feuil1"
  Feuil1.Activate
End Sub

Bonne nuit !


ROGER2327
#6892

Samedi 7 Haha 141 (Saint Prout, abbé - fête Suprême Quarte)
21 Vendémiaire An CCXXII, 8,8947h - chanvre
2013-W41-6T21:20:50Z

 

[Jacou]

Re : Faire un code un peu moins long

Bonsoir,
la V1 fonctionne chez moi. Mais pour la V1.1 le Ctrl+J ne fonctionne plus

 

[mapomme]

Re : Faire un code un peu moins long

Bonjour ROGER2327, Jacou, le forum,

Merci à tous les deux d'avoir testé

ROGER2327,
Merci beaucoup pour votre correction (en reprenant mon fichier v1, je viens de me faire piéger!)

Jacou,
Je n'arrive pas à reproduire le défaut qui vous affecte (versionv1.1) mais comme la v1 fonctionne...

Donc je remets ici une seule version "Afficher-masquer Feuilles v2.xlsm" qui correspond à la v1 corrigée très justement avec la proposition de ROGER2327.

 

[Regueiro]

Re : Faire un code un peu moins long

Bonsoir à Tous.
Une autre variante :
Attention à l'ouverture du Classeur toutes les feuilles sont masquées ( xlSheetVeryHidden )
Sauf la Feuille "Accueil"

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  MsgBox " LE CLASSEUR SERA PROTEGER A SA FERMETURE", vbOKOnly, "Merci !"
  'Protéger les Feuilles du Classeur
  Wslock
  ThisWorkbook.Save
End Sub

Private Sub Workbook_Open()
  On Error Resume Next
  Dim Feuille As Worksheet
  Application.ScreenUpdating = False
  For Each Feuille In ThisWorkbook.Worksheets
    If Feuille.Name <> "Accueil" Then
      Feuille.Visible = True
    Else
      Feuille.Visible = xlSheetVeryHidden
    End If

  Next
  Application.ScreenUpdating = True
  ThisWorkbook.Worksheets("Accueil").Activate
  ActiveSheet.Range("L9").Activate

End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
  '======== Rajouter les feuilles qui reste visible ici ================
  If InStr(1, "Accueil", Sh.Name) = 0 Then
    ThisWorkbook.Unprotect PWd
    Sh.Visible = xlSheetVeryHidden
    ThisWorkbook.Protect PWd
  End If
End Sub

Ensuite sur la feuille "Accueil" tu doubles click sur la case B2
Ouvre un Userform avec toutes les feuilles du classeur sauf la feuille " Accueil "
Tu sélectionnes une feuille dans le Combobox pour accéder à celle-ci.
Si tu veux revenir à la feuille " Accueil " tu cliques simplement sur l'onglet "Accueil".
La feuille Active sera de nouveau cachée.

Tu peux gérer le mot de passe dans le Module1

Public Const PWd$ = "TOTO" '<- ici tu changes le mot de passe

Sub Wslock(Optional Y)
'Protege ou déprotege toutes les feuilles
  Application.ScreenUpdating = False
  If IsMissing(Y) Then
    For i = 1 To ThisWorkbook.Sheets.Count
      ThisWorkbook.Sheets(i).Protect PWd
      [A1].Select

    Next
  Else
    For i = 1 To ThisWorkbook.Sheets.Count
      ThisWorkbook.Sheets(i).Unprotect PWd
      [A1].Select
    Next
  End If
End Sub

 

[lechti31]

Re : Faire un code un peu moins long

Merci beaucoup pour toutes les réponses
Mon soucis est que je ne veux pas trop changer ma présentation
Je veux garder le système de boutons
Trouvez ci-joint une ebauche de mon fichier

 

[laetitia90]

Re : Faire un code un peu moins long

bonjour tous
on pourrait passer par une class.. si tu veus conserver les boutons la soluc de l'ami mapomme bien plus simple

attention a chaque modif du code il faut relancer la macro es je l'ais mis dans open activate sheet ect..

je vois pas bien l'utilite de tout cela mais bon!!!!