XL 2013 colorier cellule avec double click

[CGU2022.]

Bonsoir à toutes et à tous
Ci dessous le code que j'ai, qui colore et décolore une cellule par double click dans les cellules b3:b20.
1- comment éviter le message "feuille protégée"
2- comment utiliser range avec plusieurs plage et cellules (exemple: B3:B5 + B7 + B9:B10)
3- "Target, Range("b3:b20")" appliquer la macro dans cette plage mais seulement la cellule de la colonne A n'est pas vide.( exemple B3 si A3<>"")

En tout cas, Un grand Merci...
Grace à ce forum j' apprend et découvre beaucoup.

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

'code qui colore la cellule avec dble click
    If Not Application.Intersect(Target, Range("b3:b20")) Is Nothing Then
        With Target
        ActiveSheet.Unprotect Password:="123"
            If Selection.Interior.ColorIndex = 6 Then
            Selection.Interior.ColorIndex = xlNone
            Else
            Selection.Interior.ColorIndex = 6
            End If
        End With
        ActiveSheet.Protect Password:="123"
    End If
End Sub

 

[mapomme]

Bonsoir,

Essayez :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Cancel = True
   If Application.Intersect(Target, Range("B3:B5,B7,B9:B10")) Is Nothing Then Exit Sub
   With Target
      ActiveSheet.Unprotect Password:="123"
      If .Offset(, -1) <> "" Then .Interior.ColorIndex = IIf(.Interior.ColorIndex = 6, xlNone, 6)
      ActiveSheet.Protect Password:="123"
   End With
End Sub

 

[sylvanu]

Bonsoir CGU,
Un essai en PJ avec :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'code qui colore la cellule avec dble click
    If Not Application.Intersect(Target, Range("B3:B5,B7,B9:B10")) Is Nothing Then
        With Target
        ActiveSheet.Unprotect Password:="123"
            If Cells(Target.Row, Target.Column - 1) <> "" Then
                If Selection.Interior.ColorIndex = 6 Then
                    Selection.Interior.ColorIndex = xlNone
                Else
                    Selection.Interior.ColorIndex = 6
                End If
                Cells(Target.Row, Target.Column + 1).Select
            End If
        End With
        ActiveSheet.Protect Password:="123"
    End If
End Sub

 

[CGU2022.]

Bonsoir,

Essayez :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Cancel = True
   If Application.Intersect(Target, Range("B3:B5,B7,B9:B10")) Is Nothing Then Exit Sub
   With Target
      ActiveSheet.Unprotect Password:="123"
      If .Offset(, -1) <> "" Then .Interior.ColorIndex = IIf(.Interior.ColorIndex = 6, xlNone, 6)
      ActiveSheet.Protect Password:="123"
   End With
End Sub

merci, merci

 

[CGU2022.]

Bonsoir CGU,
Un essai en PJ avec :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'code qui colore la cellule avec dble click
    If Not Application.Intersect(Target, Range("B3:B5,B7,B9:B10")) Is Nothing Then
        With Target
        ActiveSheet.Unprotect Password:="123"
            If Cells(Target.Row, Target.Column - 1) <> "" Then
                If Selection.Interior.ColorIndex = 6 Then
                    Selection.Interior.ColorIndex = xlNone
                Else
                    Selection.Interior.ColorIndex = 6
                End If
                Cells(Target.Row, Target.Column + 1).Select
            End If
        End With
        ActiveSheet.Protect Password:="123"
    End If
End Sub

merci, merci