Autres [RÉSOLU] Faire afficher ligne sur tout le classeur par double clic et la faire maquer à l’enregistrement

un internaute

XLDnaute Impliqué
Bonjour le forum
Je voudrais faire afficher la ligne 5 sur tout le classeur en double clic sur n'importe quelle feuille mais sans avoir macro dans module standard => AfficherMasquerLigne5()
Puis la faire masquer à l'enregistrement
Ce que ça fait maintenant mais avec module AfficherMasquerLigne5()
Merci à vous pour vos éventuelles réponses

Code module standard

VB:
Sub AfficherMasquerLigne5()   'Macro pour faire afficher ligne 5 dans tout le classeur
    For i = 1 To Sheets.count
        If Sheets(i).Name <> "MENU" Then
            With Sheets(i)
                If .Rows(5).Hidden = True Then
                    .Rows(5).Hidden = False
                Else
                    .Rows(5).Hidden = True
                End If
            End With
        End If
    Next i
End Sub

Code pour l'enregistrement

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).Range("F1,H1,I1").EntireColumn.Hidden = True
          Sheets(i).Rows(5).Hidden = True
          
        End If
    Next i
            Range("A1").Select
        On Error GoTo 0
    Sheets(FeuilleActive).Select

Sortie:
    Application.EnableEvents = True

End Sub


Double click ci-dessous

Code:
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$3"
        If Not Target.Comment Is Nothing Then AfficherMasquerLigne5   'ligne à supprimer pour éviter le module standard
    Case "$J$1"
        UsfChoix.Show 0
    Case "$E$1"
    
      For Each Ws In Sheets
        Ws.Range("F1,H1,I1").EntireColumn.Hidden = Not Ws.Range("F1,H1,I1").EntireColumn.Hidden
    Next Ws
    Exit Sub
     End Select
    If Not Intersect(Range("H6:H36"), Target) Is Nothing Then
    Cancel = True
    TbCoul = Array(8, 5)
    Tb = Array("", "toto")

    'X = UCase(Trim(Target))   'Pour mettre en Majuscule
    X = (Trim(Target))
    If UBound(Filter(Tb, X)) >= 0 Then
      Indice = Application.Match(X, Tb, 0) Mod (1 + UBound(Tb))
        Target = Tb(Indice)
        Couleur = TbCoul(Indice)
        If Couleur = 0 Then
          Couleur = Target.Offset(0, -1).Interior.ColorIndex
        End If
        Target.Interior.ColorIndex = Couleur
    Else
        Target = ""
    End If
     ElseIf Not Intersect(Range("I6:I36"), Target) Is Nothing Then
    Cancel = True
    TbCoul = Array(8, 16, 3)
    Tb = Array("", "SP 95", "SP 98")
    'X = UCase(Trim(Target))   'Pour mettre en Majuscule
    X = (Trim(Target))
    If UBound(Filter(Tb, X)) >= 0 Then
      Indice = Application.Match(X, Tb, 0) Mod (1 + UBound(Tb))
        Target = Tb(Indice)
        Couleur = TbCoul(Indice)
        If Couleur = 0 Then
          Couleur = Target.Offset(0, -1).Interior.ColorIndex
        End If
        Target.Interior.ColorIndex = Couleur
    Else
        Target = ""
    End If
End If
 

un internaute

XLDnaute Impliqué
Bonjour fanch55
Oui mais il y est déjà
Je ne veux plus le module standard => AfficherMasquerLigne5
C'est un truc comme ça je pense mais à quel endroit
Et il faut que la ligne s'affiche dans toutes les feuilles et à l'enregistrement se masque
If Target.Column = 1 Then Rows(5).Hidden = Not Rows(5).Hidden

Merci à toi
 

fanch55

XLDnaute Barbatruc
Code modifié.
VB:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim Ws As Worksheet
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        FeuilleActive = ActiveSheet.Name
        On Error Resume Next
            For Each Ws In Worksheets
                With Ws
                    If .Name <> "MENU" Then
                        .Range("F1,H1,I1").EntireColumn.Hidden = True
                        .Rows(5).Hidden = True
                    End If
                End With
            Next
        On Error GoTo 0
    Application.EnableEvents = True

End Sub
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
 ' Cancel = Not Cancel ????

 Application.ScreenUpdating = False
    Dim Ws As Worksheet, Hidden As Boolean
    For Each Ws In Worksheets
        If Ws.Name <> "MENU" Then Ws.Rows(5).Hidden = False
    Next
    
    Select Case Target.Address
'    Case "$A$3"
'        If Not Target.Comment Is Nothing Then AfficherMasquerLigne5   'ligne à supprimer pour éviter le module standard
    Case "$J$1":  UsfChoix.Show 0
    Case "$E$1":
        ' On passe par hidden pour que toutes les feuilles soient synchrones
        Hidden = ""
        If Hidden = "" Then Hidden = Not Ws.Range("F1,H1,I1").EntireColumn.Hidden
        For Each Ws In Worksheets
            Ws.Range("F1,H1,I1").EntireColumn.Hidden = Hidden
        Next
        Exit Sub
    End Select
    If Not Intersect(Range("H6:H36"), Target) Is Nothing Then
        Cancel = True
        TbCoul = Array(8, 5)
        Tb = Array("", "toto")
    
        'X = UCase(Trim(Target))   'Pour mettre en Majuscule
        X = Trim(Target)
        If UBound(Filter(Tb, X)) >= 0 Then
          Indice = Application.Match(X, Tb, 0) Mod (1 + UBound(Tb))
            Target = Tb(Indice)
            Couleur = TbCoul(Indice)
            If Couleur = 0 Then
              Couleur = Target.Offset(0, -1).Interior.ColorIndex
            End If
            Target.Interior.ColorIndex = Couleur
        Else
            Target = ""
        End If
    ElseIf Not Intersect(Range("I6:I36"), Target) Is Nothing Then
        Cancel = True
        TbCoul = Array(8, 16, 3)
        Tb = Array("", "SP 95", "SP 98")
        'X = UCase(Trim(Target))   'Pour mettre en Majuscule
        X = (Trim(Target))
        If UBound(Filter(Tb, X)) >= 0 Then
            Indice = Application.Match(X, Tb, 0) Mod (1 + UBound(Tb))
            Target = Tb(Indice)
            Couleur = TbCoul(Indice)
            If Couleur = 0 Then
                Couleur = Target.Offset(0, -1).Interior.ColorIndex
            End If
            Target.Interior.ColorIndex = Couleur
        Else
            Target = ""
        End If
    End If

End Sub
 

un internaute

XLDnaute Impliqué
Bonjour fancj55
je n'ai pas tout vérifié que ce matin
La ligne 5 nickel mais les colonnes F1 H1 I1 en double cliquant sur E2 ça bug sur Hidden =""

1683175858021.png

Cordialement
 

fanch55

XLDnaute Barbatruc
Code corrigé ( d'origine, c'était déclenché par E1 pas par E2 )
VB:
    Case "$E$1":
        ' On passe par hidden pour que toutes les feuilles soient synchrones
        Dim Hidden As Variant: Hidden = ""
        For Each Ws In Worksheets
            If Hidden = "" Then Hidden = Not Ws.Range("F1,H1,I1").EntireColumn.Hidden
            Ws.Range("F1,H1,I1").EntireColumn.Hidden = Hidden
        Next
        Cancel = True
        Exit Sub
 

Discussions similaires

Statistiques des forums

Discussions
313 198
Messages
2 096 144
Membres
106 503
dernier inscrit
ngomez