Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

U

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
 
Trier par date Trier par votes
U

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
 
Vote positif 0 Vote négatif
U

un internaute

XLDnaute Impliqué
Non lorsqu'on double clic cellule A3 ça affiche la ligne 5 sur toutes les feuilles
A l’enregistrement ça masque la ligne 5 sur tout le classeur
Il faut oublier le module standard => AfficherMasquerLigne5
 
Vote positif 0 Vote négatif

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
 
Vote positif 0 Vote négatif
U

un internaute

XLDnaute Impliqué
Ah! oui NICKEL
Je pense que je me suis mal exprimé comme d’habitude avec toutes mes excuses... de plus sans fichier encore plus difficile
Un GRAND merci et toutes mes excuses renouvelées
Cordialement
 
Vote positif 0 Vote négatif
U

un internaute

XLDnaute Impliqué
Re fanch 55

J'ai mis ça en commentaires ça a l'air de fonctionner

VB: 
        ' On passe par hidden pour que toutes les feuilles soient synchro
'        Hidden = ""
'        If Hidden = "" Then Hidden = Not Ws.Range("F,H,I").EntireColumn.Hidden
 
Vote positif 0 Vote négatif

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
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

U
  • Question
Autres [RÉSOLU] Pour faire afficher colonne F par double clic dans tout le classeur
Réponses
3
Affichages
370
vgendron
U
  • Question
Autres Enregistrer sur Onglet TOTO
Réponses
2
Affichages
389
un internaute
U
N
  • Résolu(e)
Microsoft 365 Ajouter une condition dans une VBA
Réponses
2
Affichages
212
Nathan027
N
N
  • Question
Microsoft 365 Imbrication de deux formule Worksheet_BeforeDoubleClick
Réponses
1
Affichages
155
Nathan027
N
F
  • Résolu(e)
XL 2021 fermeture du classeur après apple d'un userform d'un autre classeur ouvert
Réponses
2
Affichages
108
farid
F
  • Résolu(e)
XL 2016 Indice n'appartient pas à la sélection : HELP !!!!
2
Réponses
21
Affichages
552
halecs93
U
  • Question
Autres [RÉSOLU] Problème macro mais lequel?
Réponses
4
Affichages
386
un internaute
U
U
  • Question
Autres [RESOLU] Application.ScreenUpdating = False
Réponses
4
Affichages
924
un internaute
U
D
  • Question
XL 2021 VBA - Erreur 1004 aléatoire - Image/Logo
Réponses
10
Affichages
373
crocrocro
C
S
  • Question
Microsoft 365 créer un macro vba
Réponses
0
Affichages
157
souhaib ad
S
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…