VBA - Insérer texte par double clics

Bonjour,

Dans les cellules de la colonne C qui ont une liste déroulante ( , Correct, Incorrect, N/A) et dont la feuille est verrouillée mais pas les cellules de la colonne C, j'aimerai pouvoir insérer par double clics le texte "Correct" et vider la cellule si je double clic une seconde fois.

J'ai ce code mais apparemment il y a une incompatibilité entre la liste déroulante et le double clic :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ActiveSheet.UnProtect Password:="."
    If Not Intersect(Target, Range("C:C")) Is Nothing Then
        Cancel = True
        If Target = "" Then
            Target = "Correct"
        Else
            Target = ""
        End If
    End If
    ActiveSheet.protect Password:="."
End Sub

Avez-vous une solution pour que je puisse insérer ce texte "Correct" tout en gardant la liste déroulante?

Mes meilleures salutations,

Thierry

Bonjour Thierry36,

En retour un code pour ta demande.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.DisplayAlerts = False
If Not Intersect(Target, Range("C:C")) Is Nothing Then
ActiveCell = IIf(ActiveCell = "", "Correct", "")
End If
ActiveCell.Offset(0, -1).Select
ActiveSheet.Protect Password:="."
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("C:C")) Is Nothing Then
ActiveSheet.Unprotect Password:="."
End If
End Sub

Note que ma liste de validation comporte au début le caractère _

Ainsi est marqué une non-réponse. Mais c'est facultatif.

Bonjour X Cellus,

Votre code fonctionne parfaitement bien. Merci beaucoup pour votre aide.

Mes respectueuses salutations,

Thierry

A nouveau,

ActiveSheet.Protect Password:="."
Application.DisplayAlerts = True
End Sub

Ne pas oublier de remettre les alertes (DisplayAlert) pour rétablir si erreur faîte par un utilisateur.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
ActiveSheet.Protect Password:="."
    If ActiveSheet.ProtectContents = True Then
       ActiveSheet.Unprotect Password:="."
       Cancel = True
            If Target.Column = 3 Then
                If IsEmpty(Target) Then
                    Target = "Correct"
                Else
                    Target = Empty
                End If
            End If
       ActiveSheet.Protect Password:="."
    End If
End Sub