Ouvrir certains onglets avec macro

Bonjour le forum

J'ai des onglets qui vont de Année 2004 à Année 2021.

Avec la macro ci-dessous j'ouvre tous les onglets si nécessaire mais je ne voudrais faire ouvrir que de 2016 à 2021.

Sub AfficherOnglets()
Application.ScreenUpdating = False
Dim Onglets As Worksheet
   For Each Onglets In Worksheets
    Onglets.Visible = True
  Next Onglets
Application.ScreenUpdating = True
End Sub

Avez-vous une idée ?

Merci pour vos éventuels retours

Cordialement

Bonjour

Essaie ça :

Option Explicit

Dim f As Worksheet
Dim i&

Sub ess()
    For i = 2016 To 2021
        Sheets("Annee " & i).Visible = True
    Next i
End Sub

Bye !

Bonjour gmb

Curieux ton code ou alors pas compris

Bonjour
Probablement pas compris, car il est difficile de faire plus simple. Tu ajouteras l'accent aigu sur "Année " et le tour est joué.

C'est peut-être la déclaration de la variable i qui t'a surpris :
- Dim i& = Dim i as Long
- Dim i% = Dim i as Integer
- Dim i@ = Dim i as Currency
- Dim i! = Dim i as Single
- Dim i# = Dim i as Double
- Dim i$ = Dim i as String

Au passage, tu n'as pas besoin d'accélérer le process en ajoutant les lignes Application.ScreenUpdating = False...True

Bonjour Optimix

Quel C$N!!!

Oui déclaration de variable et l'accent

Merci à vous deux

Bonne journée

Cordialement

Bonjour le forum

Il m'est venu une idée (encore une C$$$$$$$E sans doute)

Peut-on par double clic

1 er double clic afficher la totalité des onglets (2004 à 2021)

2ème double clic les onglets de 2016 à 2021

Merci pour vos éventuels retours

Cordialement

Ce n'est pas un problème avec une variable publique, mais je laisserai la réponse à gmb. Bye.

Bonjour Optimix

J'y travaille et reviens vers vous

Cordialement

Bonjour

Bonjour à tous

Nouvelle version

Bye !

Bonjour gmb le forum

J'ai fait avec macro ci-dessous qui fonctionne très bien

Mais ta macro gmb m’intéresse. Si j'ai bien compris c'est sur la cellule A1 le double clic.

Moi je le voudrais sur cellule F2.

Un grand merci

A+

Sub AfficherTousLesOnglets()
Dim Onglets As Worksheet
Dim Sh As Shape
Dim I As Integer, Feuilles As String

  Application.ScreenUpdating = False
  ActiveSheet.Unprotect
  Set Sh = ActiveSheet.Shapes(Application.Caller)
  If Left(Sh.TextFrame.Characters.Text, 9) = "Visionner" Then
    For Each Onglets In Worksheets
      Onglets.Visible = True
    Next Onglets

    Sh.TextFrame.Characters.Text = "Afficher les Années " & Chr(10) & "De 2016 à la dernière"

    ' On modifie tout le texte : Fonte,Taille,Couleur,Souligné etc ...
    With Sh.TextFrame.Characters.Font
      .Name = "Tahoma"
      .FontStyle = "Gras italique"
      .Size = 18
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .ColorIndex = 3
    End With

    ' On change la couleur de certaines partie du texte
    ' De
    Sh.TextFrame.Characters(Start:=21, Length:=3).Font.ColorIndex = 5
    ' à la
    Sh.TextFrame.Characters(Start:=29, Length:=5).Font.ColorIndex = 5

  Else
  Feuilles = " 2016 2017 2018 2019 2020 2021 2022 2023 2024"
  For I = 1 To Sheets.Count
    If InStr(1, Feuilles, Right(Sheets(I).Name, 5)) = 0 Then Sheets(I).Visible = xlSheetVeryHidden
  Next I
    Sh.TextFrame.Characters.Text = "Visionner toutes les Années" & Chr(10) & "Enregistrement Automatique" & Chr(10) & "Année en cours"

    ' On modifie tout le texte : Fonte,Taille,Couleur,Souligné etc ...
    With Sh.TextFrame.Characters.Font
      .Name = "Tahoma"
      .FontStyle = "Gras italique"
      .Size = 18
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .ColorIndex = 3
    End With

    ' On change la couleur de la partie du texte concernée
    ' Enregistrement Automatique
    Sh.TextFrame.Characters(Start:=29, Length:=26).Font.ColorIndex = 5

  End If
  ActiveSheet.Protect UserInterfaceOnly:=True, DrawingObjects:=False
  Application.ScreenUpdating = True
End Sub

Bonjour à tous,

@gmb : puis-je me permettre une petite demande ?

Je visite très souvent le forum depuis mon téléphone. Pas moyen donc d'ouvrir les .xlsm et de voir tes codes qui sont pourtant une mine d'or quand on veut progresser et essayer de coder correctement.

Te serait-il possible de rajouter dans tes messages sur les posts, un copier/coller du code que tu as mis dans le fichier ? Ce serait très sympa de ta part et, je pense, utile à nombre d'entre nous.

Par avance merci !

Bonjour…

Pour ne cacher que les premiers onglets, cela suffirait-il ?

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Dim a As Long
    For a = 2004 To 2015
        Sheets("Année " & a).Visible = IIf(Sheets("Année " & a).Visible = 2, -1, 2)
    Next
    Cancel = 1
End Sub

Nota : 2 pour VeryHidden et -1 pour Visible

Bonjour ordonc

Dans ThisWorkbook j'ai ça et c'est là que ça bloque

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  Cancel = True
  If Target.Address = "$A$2" Then
    Rows(3).Hidden = Not Rows(3).Hidden
  ElseIf Target.Address = "$F$2" Then
  If Not Intersect(Target, Union(Range("A2"), Range("F2"))) Is Nothing Then

    For Each Sh In Sheets
      If Sh.Visible <> xlSheetVisible Then Afficher: Exit Sub
    Next
    MasquerSauf "Année " & Year(Date) 'Adapter Nom Onglet
  End If
  Range("A1").Select
  End If
End Sub

Dans un module => AfficherOnglets j'ai macro ci-dessous

Sub Afficher()
  Dim Sh As Object
  Application.ScreenUpdating = False
  For Each Sh In Sheets
      Sh.Visible = xlSheetVisible
  Next
  Application.ScreenUpdating = True
End Sub

Sub MasquerSauf(nom$)
Dim Sh As Object
  Application.ScreenUpdating = False
  On Error Resume Next
  If IsError(Sheets(nom)) Then MsgBox "Créez la feuille '" & nom & "' !", 48: Afficher: Exit Sub
  For Each Sh In Sheets
      If Sh.Name <> nom Then Sh.Visible = xlSheetHidden
  Next
  Application.ScreenUpdating = True
End Sub

Il y a incompatibilité entre ce que vous faites et ce que j'ai.

Au 1er double clic (F2) ça affiche bien tous les Onglets => normal

Ce que je voudrais si c'est possible (mais sans fichier compliqué)

Qu'au 2ème double clic ça affiche les Onglets de 2016 à 20121

Merci à tous

PS: Je m'excuse pour le fichier

Bonjour à tous

@ JoyeuxNoel

Merci pour la mine d'or, même si c'est très exagéré. Ça fait toujours plaisir.

...rajouter dans tes messages sur les posts, un copier/coller du code que tu as mis dans le fichier ?

Ok , j'essaierai désormais d'y penser.

Bye !

Re et bonjour aus Atres ...

tu as déjà 2 actions prévues en cas de doubleclic avec A2 e F2.

Si tu en veux une de plus il te faudra passer par une autre cellule que les précédentes ou, changer d’évènement par exemple, ajouter (dans ThisworkBook)

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As       Range, Cancel As Boolean)
    Cancel = 1
    If Target.Address <> "$A$2" Then Exit Sub
    For i = 2004 To 2015
        Sheets("Année " & i).Visible = Not Sheets("Année " & i).Visible
    Next
End Sub

Remarques

1 dans ton exemple, tu demandes de créer un onglet mais ce n’est pas programmé. Dans le fichier joint, j’ai repris cela et tout se passe seulement dans ThisWorBook.

2 si tu as des feuilles protégées, pour y accéder, pense à les déprotéger (évènement Activate ) puis à les re protéger (évènement Deactivate).