Afficher lignes par double clic

pad01

XLDnaute Occasionnel
Bonsoir Forum,
J'ai trouvé une macro qui fait apparaitre ou cache les sous-titres après avoir double cliquer sur le titre (macro de Jacques Boisgontier). Elle répond parfaitement à ma demande.
Le soucis est lorsque le titre n'a pas de sous-titre, cela provoque un message d'erreur (Titre4).
Comment faire pour ne plus avoir ce message.
Cordialement
 

Pièces jointes

  • DoubleClic_Pad.xls
    39 KB · Affichages: 50

phlaurent55

Nous a quittés en 2020
Repose en paix
Re : Afficher lignes par double clic

Bonjour pad,

remplace ton code par ceci:
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error GoTo fin
   If ActiveCell.Column = 2 And ActiveCell.Font.Bold = True Then
     If Not ActiveCell.Offset(1, 0).EntireRow.Hidden Then
        i = 1
        Do While Not ActiveCell.Offset(i, 0).Font.Bold And Not IsEmpty(ActiveCell.Offset(i, 0))
          i = i + 1
        Loop
        ActiveCell.Offset(1, 0).Resize(i - 1).EntireRow.Hidden = True
      Else
        i = 1
        Do While ActiveCell.Offset(i, 0).EntireRow.Hidden
          i = i + 1
        Loop
        ActiveCell.Offset(1, 0).Resize(i - 1).EntireRow.Hidden = False
     End If
     Cancel = True
   End If
fin:
Exit Sub
End Sub
à+
Philippe
 

kjin

XLDnaute Barbatruc
Re : Afficher lignes par double clic

Bonsoir,
Tu peux tester la valeur de i par exemple
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   If ActiveCell.Column = 2 And ActiveCell.Font.Bold = True Then
     If Not ActiveCell.Offset(1, 0).EntireRow.Hidden Then
        i = 1
        Do While Not ActiveCell.Offset(i, 0).Font.Bold And Not IsEmpty(ActiveCell.Offset(i, 0))
          i = i + 1
        Loop
        If i > 1 Then ActiveCell.Offset(1, 0).Resize(i - 1).EntireRow.Hidden = True
      Else
        i = 1
        Do While ActiveCell.Offset(i, 0).EntireRow.Hidden
          i = i + 1
        Loop
        If i > 1 Then ActiveCell.Offset(1, 0).Resize(i - 1).EntireRow.Hidden = False
     End If
     Cancel = True
   End If
End Sub
A+
kjin
 

Discussions similaires

Statistiques des forums

Discussions
312 379
Messages
2 087 762
Membres
103 661
dernier inscrit
fcleves