Autres [RÉSOLU] Problème macro mais lequel?

un internaute

XLDnaute Impliqué
Bonsoir le forum
Dans la macro ci-dessous ça a l'air de fonctionner
Lorsque je double click sur cellule A2 sur n'importe quelle feuille ça affiche bien les colonnes K L P sur tout le classeur

VB:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
 Dim Ws As Worksheet
 Cancel = Not Cancel

 Application.ScreenUpdating = False
  Select Case Target.Address
    Case "$A$2"
      For Each Ws In Sheets
        Ws.Range("K1:L1,P1:P1").EntireColumn.Hidden = Not Ws.Range("K1:L1,P1").EntireColumn.Hidden
    Next Ws

  End Select
End Sub

Mais à l'enregistrement ça referme bien les dites colonnes sur tout le classeur mais toutes les feuilles restent affichées sauf celle qui doit rester afficher obligatoire

Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim I As Long
    Application.ScreenUpdating = False
    Dim FeuilleActive As String
    Application.EnableEvents = False
    FeuilleActive = ActiveSheet.Name
    For I = 1 To Sheets.Count
        On Error Resume Next
        If Sheets(I).Name <> "MENU" Then
            Sheets(I).Select
            Range("K1:L1,P1:P1").EntireColumn.Hidden = True
'           Range("K1").EntireColumn.Hidden = True
            With Sheets(I)
            End With
        End If
    Next I

            Range("A1").Select
        On Error GoTo 0
    Sheets(FeuilleActive).Select

Sortie:
    Application.EnableEvents = True
End Sub
Je ne vois pas d'où ça bien.
Pourrais-je avoir recours à vos lumières?
Merci d'avance
Cordialement
 

Phil69970

XLDnaute Barbatruc
Bonjour @un internaute

Je te propose 2 solutions

1ere solution
Au tout début de la macro Il manque :

Option Compare Text

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim Ws As Worksheet
Cancel = Not Cancel

Application.ScreenUpdating = False
Select Case Target.Address
Case "$A$2"
For Each Ws In Sheets
Ws.Range("K1:L1,P1").EntireColumn.Hidden = Not Ws.Range("K1:L1,P1").EntireColumn.Hidden
Next Ws

End Select
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim I As Long
Application.ScreenUpdating = False
Dim FeuilleActive As String
Application.EnableEvents = False
FeuilleActive = ActiveSheet.Name
For I = 1 To Sheets.Count
On Error Resume Next
If Sheets(I).Name <> "MENU" Then
Sheets(I).Select
Range("K1:L1,P1").EntireColumn.Hidden = True
' Range("K1").EntireColumn.Hidden = True
With Sheets(I)
End With
End If
Next I

Range("A1").Select
On Error GoTo 0
Sheets(FeuilleActive).Select

Sortie:
Application.EnableEvents = True
End Sub

2eme solution

==> MENU n'est pas pareil que Menu
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim Ws As Worksheet
Cancel = Not Cancel

Application.ScreenUpdating = False
Select Case Target.Address
Case "$A$2"
For Each Ws In Sheets
Ws.Range("K1:L1,P1").EntireColumn.Hidden = Not Ws.Range("K1:L1,P1").EntireColumn.Hidden
Next Ws

End Select
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim I As Long
Application.ScreenUpdating = False
Dim FeuilleActive As String
Application.EnableEvents = False
FeuilleActive = ActiveSheet.Name
For I = 1 To Sheets.Count
On Error Resume Next
If Sheets(I).Name <> "Menu" Then
Sheets(I).Select
Range("K1:L1,P1").EntireColumn.Hidden = True
' Range("K1").EntireColumn.Hidden = True
With Sheets(I)
End With
End If
Next I

Range("A1").Select
On Error GoTo 0
Sheets(FeuilleActive).Select

Sortie:
Application.EnableEvents = True
End Sub

Merci de ton retour

@Phil69970
 

un internaute

XLDnaute Impliqué
Bonjour Phil69970
Ça ne ferme pas les onglets sauf 1 qui est dans cette macro
Merci à toi
Cordialement

VB:
Sub AfficherMasquerOnglets(Optional Affiche As Integer)
Dim Ws As Worksheet, feuille As Worksheet, I As Integer
Dim LesFeuilles

  Application.ScreenUpdating = False
  Set Ws = ActiveSheet
  If Affiche = 0 Then
    Affiche = xlSheetVeryHidden
    For I = 1 To Sheets.Count
      If Sheets(I).Visible = xlSheetVeryHidden Then Affiche = True: Exit For
    Next I
  End If
  For Each feuille In Sheets
    Select Case feuille.Name
      Case "LEVET - LAGEDAMON"
      Case Else
        With feuille
'.Unprotect
          .Visible = Affiche
'.Protect UserInterfaceOnly:=True
        End With
    End Select
  Next feuille
End Sub
 

Phil69970

XLDnaute Barbatruc
Re

@un internaute

Le code du post #1 que tu as fourni cache ou pas des colonnes (enfin essaye)
Le code que tu as fourni au départ ne fonctionnait pas du moins la partie :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Ce code là je l'ai rectifié dans mon post # 2

Maintenant tu mets un autre code dans ton post # 3
Le code posté ne fait pas partie de la question de départ .

Rappel de la charte :

1685081355960.png


Maintenant si tu veux masquer ou afficher les feuilles voici le principe

Toutes les feuilles seront cachés sauf la feuille menu et bien sur si tu as protegé les feuilles il faut les déprotéger avant et les reproteger apres

VB:
Sub MasqueFeuilles()
Dim Sh As Worksheet
Application.ScreenUpdating = False

For Each Sh In Sheets
   If Sh.Name <> "Menu" Then
        Sheets("Menu").Activate
        Sh.Visible = xlVeryHidden
   End If
Next
End Sub

Sub AfficheFeuilles()
Dim Sh As Worksheet
Application.ScreenUpdating = False
For Each Sh In Sheets
    Sh.Visible = True
Next
End Sub

@Phil69970
 
Dernière édition:

Discussions similaires