XL 2013 colorier cellule avec double click

CGU2022.

XLDnaute Junior
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. 👍 👍 👍




VB:
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
 

Pièces jointes

  • test.xlsm
    46.5 KB · Affichages: 6

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonsoir,

Essayez :
VB:
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
 

Pièces jointes

  • CGU2022.- Colorer cellule- v1.xlsm
    47.9 KB · Affichages: 7
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir CGU,
Un essai en PJ avec :
VB:
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
 

Pièces jointes

  • test.xlsm
    46.5 KB · Affichages: 7

CGU2022.

XLDnaute Junior
Bonsoir,

Essayez :
VB:
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.

XLDnaute Junior
Bonsoir CGU,
Un essai en PJ avec :
VB:
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 ;)
 

Discussions similaires

Réponses
7
Affichages
292