Masquer cellules vides et colonnes à l'enregistrement

Bonjour le forum

Je reviens à mon sujet de hier au soir

Tout fonctionne bien mais j'ai pensé à un truc

Lorsque je clique sur F2 pour afficher tous les onglets, lorsque j'enregistre les onglets sont masqués sur l'année en cours.

Peut-on à l'enregistrement faire masquer les cellules vides et les colonnes de G à I dans la macro ci-dessous au lieu de refaire un double clic?

Merci à vous

Cordialement

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Target.Count > 1 Then Exit Sub

If Not Target.Comment Is Nothing Then

If Not Intersect(Target, [A2:A8]) Is Nothing Then

Call RegularisationsExplications

End If

If Target.Row = 2 And Target.Column = 6 And Target.Count = 1 Then

Application.ScreenUpdating = 0

For Each sh In Worksheets

sh.Visible = 1

Next sh

End If

End If

Range("A1").Select

End Sub

Autre macro

Sub RegularisationsExplications()

Application.ScreenUpdating = False

With ActiveSheet

.Unprotect

If .Columns("G:I").Hidden = True Then

.Columns("G:I").Hidden = False

Else: .Columns("G:I").Hidden = True

End If

For Each Cel In .Range("E12:E16,E18:E31,E41:E45,E47:E60,E70:E74,E76:E89,E99:E103,E105:E118")

If Cel = "" Then

Cel.EntireRow.Hidden = Not Cel.EntireRow.Hidden

End If

Next Cel

.Range("A1").Select

.Protect

End With

Application.ScreenUpdating = False

End Sub

Bonjour,

Pour nos yeux et également pour les tiens ... .... de l'utilité des Balises Code ...

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
  If Not Target.Comment Is Nothing Then
      If Not Intersect(Target, [A2:A8]) Is Nothing Then
          Call RegularisationsExplications
      End If
      If Target.Row = 2 And Target.Column = 6 And Target.Count = 1 Then
      Application.ScreenUpdating = 0
          For Each sh In Worksheets
              sh.Visible = 1
          Next sh
      End If
  End If
Range("A1").Select
End Sub

Sub RegularisationsExplications()
Application.ScreenUpdating = False
    With ActiveSheet
        .Unprotect
          If .Columns("G:I").Hidden = True Then
              .Columns("G:I").Hidden = False
          Else
              .Columns("G:I").Hidden = True
          End If
          For Each Cel In .Range("E12:E16,E18:E31,E41:E45,E47:E60,E70:E74,E76:E89,E99:E103,E105:E118")
            If Cel = "" Then
              Cel.EntireRow.Hidden = Not Cel.EntireRow.Hidden
            End If
          Next Cel
        .Range("A1").Select
        .Protect
    End With
Application.ScreenUpdating = False
End Sub

Bonjour James007

C'est à dire?

al87 a écrit :

Bonjour James007

C'est à dire?

Ne pas hésiter à utiliser les Balises Code ...

Tu as déjà 447 messages ... donc ta familiarité avec le Forum doit être grande ... !!!

Re James007

Oh! toutes mes excuses

Voici un fichier

Merci à toi

Re,

Tu as déjà cette macro au moment de l'enregistrement ...

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  ActiveSheet.Range("A10").Select   'Si volets figés Ligne 9 par exemple
  ActiveSheet.Range("A1").Select    'Ajouter cette ligne pour retour à la cellule A1
End Sub

Veux-tu la supprimer ou simplement la modifier ?

James007 a écrit :

Re,

Tu as déjà cette macro au moment de l'enregistrement ...

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  ActiveSheet.Range("A10").Select   'Si volets figés Ligne 9 par exemple
  ActiveSheet.Range("A1").Select    'Ajouter cette ligne pour retour à la cellule A1
End Sub

Veux-tu la supprimer ou simplement la modifier ?

La modifier pour qu'elle masque les lignes vide et les colonnes de G à I à l'enregistrement au lieu de Double cliquer sur A2

mais toujours laisser la possibiliter de le faire manuellement

Merci à toi

Re,

Je trouve que tu as déjà réalisé beaucoup de choses dans ton fichier ... Félicitations ...

Surtout pas dans ton véritable fichier mais dans une copie ... ... tu peux tester la macro suivante ...

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Dim Cel As Range
  With ActiveSheet
      .Range("A10").Select   'Si volets figés Ligne 9 par exemple
      .Range("A1").Select    'Ajouter cette ligne pour retour à la cellule A1
      .Columns("G:I").Hidden = True
      For Each Cel In .Range("E12:E16,E18:E31,E41:E45,E47:E60,E70:E74,E76:E89,E99:E103,E105:E118")
          If Cel = "" Then Cel.EntireRow.Hidden = Not Cel.EntireRow.Hidden
      Next Cel
  End With
Application.ScreenUpdating = True
End Sub

En espèrant que cela t'aide

Merci James007

Ça fonctionne bien sous toto et mon fichier réel

Je viens de me rendre compte que si j'enregistre ça ferme bien les lignes vides et les colonnes et si je ré-enregistre ça ré-ouvrent les lignes mais pas les colonnes.

Ça serait super si on pouvait le faire.

Redondance macro feuille et celle de ThisWorkbook?

De rien ...

Pourrais-tu éclaircir un peu ...

Si tu sauvegardes ton fichier une deuxième fois ... que faut-il qui se passe ?

James007 a écrit :

De rien ...

Pourrais-tu éclaircir un peu ...

Si tu sauvegardes ton fichier une deuxième fois ... que faut-il qui se passe ?

Lorsque si par erreur je clique une 2ème fois sur enregistrer ça ré-ouvre les lignes mais pas les colonnes.

Mais ne t'acharne pas sur ça car ça a l'air de tourner sur fichier réel. En faisant A2 ça fonctionne très bien.

Fichier joint

Re,

Du coup ... une petite modif

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Dim Cel As Range
  With ActiveSheet
      .Range("A10").Select   'Si volets figés Ligne 9 par exemple
      .Range("A1").Select    'Ajouter cette ligne pour retour à la cellule A1
      .Columns("G:I").Hidden = True
      For Each Cel In .Range("E12:E16,E18:E31,E41:E45,E47:E60,E70:E74,E76:E89,E99:E103,E105:E118")
          If Cel = "" Then Cel.EntireRow.Hidden
      Next Cel
  End With
Application.ScreenUpdating = True
End Sub

Re

Ça bloque sur Cel en couleur

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Dim Cel As Range
  With ActiveSheet
      .Range("A10").Select   'Si volets figés Ligne 9 par exemple
      .Range("A1").Select    'Ajouter cette ligne pour retour à la cellule A1
      .Columns("G:I").Hidden = True
      For Each Cel In .Range("E12:E16,E18:E31,E41:E45,E47:E60,E70:E74,E76:E89,E99:E103,E105:E118")
          If[Surligner] Cel[/Surligner] = "" Then Cel.EntireRow.Hidden = Not Cel.EntireRow.Hidden
      Next Cel
  End With
Application.ScreenUpdating = True
End Sub

Cette ligne

If Cel = "" Then Cel.EntireRow.Hidden

Jamais faire de l'édition directement dans le Forum ...

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Dim Cel As Range
  With ActiveSheet
      .Range("A10").Select   'Si volets figés Ligne 9 par exemple
      .Range("A1").Select    'Ajouter cette ligne pour retour à la cellule A1
      .Columns("G:I").Hidden = True
      For Each Cel In .Range("E12:E16,E18:E31,E41:E45,E47:E60,E70:E74,E76:E89,E99:E103,E105:E118")
          If Cel = "" Then Cel.EntireRow.Hidden = True
      Next Cel
  End With
Application.ScreenUpdating = True
End Sub

UN GRAND MERCI à toi James007

Ça fonctionne correctement

Excuses moi pour toutes les "mauvaises" manoeuvres.

Je m'explique très mal dans mes demandes et quelques fois ça risque de durer!!!

Bonne journée et bon WE

Cordialement

Content que cela fonctionne ...

Au fait, aurais-tu besoin de la version toto V2 ... que je suis en train de nettoyer ...?

Si tu veux je vais le garder.

Merci à toi

Bien cordialement

Re,

Ci-joint ta Version toto V2 ...

Quelques oublis de déclarations de variables dans tout le code ... et quelles petites rationalisations pour la cohérence ...

Et encore Bravo pour tout le tarvail que tu as déjà effectué ...

En espèrant que cela t'aide

Re James007

Je suis allé faire ma marche je n'ai pas pu tout regarder en détail

Juste un petit détail à l'enregistrement le fichier ne remonte pas cellule A1 il reste dans la position où je l'ai enregistré

Voir fichier joint

Cordialement