XL 2010 VBA - Insérer texte par double clics

[tchi456]

Bonjour,

Dans les cellules de la colonne C qui ont une liste déroulante (Cellule vide, 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 je ne comprends pas pourquoi ça ne fonctionne pas:

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

Pouvez-vous m'aider?

Mes meilleures salutations,

Thierry

 

[Hasco]

bonjour,

Chez moi votre code semble faire ce que vous demandez.
Même si je l'aurais écrit différemment, il fonctionne.

Cordialement

 

[JM27]

Bonjour
Incompatibilité entre ta liste déroulante et ton double clic.
le"" ne figure pas dans ta liste de validation
si tu supprimes ta validation : ca marche

 

[tchi456]

Bonjour Jean-Marcel,

Merci pour votre message mais je souhaite garder ma liste déroulante ( , Correct, Incorrect, N/A).

Cordialement,

Thierry

 

[tchi456]

Bonjour Hasco,

Puis-je vous demander comment l'auriez-vous écrit?

Cordialement,

Thierry

 

[Hasco]

Re,

La remarque de @JM27 est pourtant pertinente. Il faudrait pouvoir empêcher l'ouverture de la liste de validation sur la sélection de la cellule, c'est la liste qui prend le Focus et non plus la cellule. Ou alors double-cliquer très très très vite 🙂

Voici une variation possible de vos lignes, où Me est la propriété par défaut qui fait référence à la feuille qui contient le code.

Si vous gérez un évènement Worksheet_Change alors il faudra inclure sans doute un Application.EnableEvents = False après le If Cancel et un autre = True Avant le End if

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   
    Cancel = Not Intersect(Target, Range("C:C")) Is Nothing
   
    If Cancel Then
        Me.Unprotect Password:="."
        Target = IIf(Target = "", "Correct", "") ' ou If Target = "" Then Target = "Correct" Else Target = ""
        Me.Protect Password:="."
    End If
   
End Sub

Cordialement

 

[tchi456]

Merci pour ces précisions Hasco.

J'aimerai tellement que VBA soit aussi simple pour moi que pour vous 😩 mais j'avoue être une pive dans ce domaine.

Bon après-midi!

 

[tchi456]

RE,

Voici un code (en chinois pour moi) mais qui fonctionne pas si mal:

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

Cordialement,

Thierry

 

[JM27]

bonjour
non cela ne marche pas
mais c'est presque bon
Pour déprotéger ta feuille : tu clic sur la une cellule en colonne c sans rien documenter, puis tu clic sur une autre cellule en colonne B par exemple : feuille déprotégée
peut être que cela le fais

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

 

[tchi456]

bonjour
non cela ne marche pas
mais c'est presque bon
Pour déprotéger ta feuille : tu clic sur la une cellule en colonne c sans rien documenter, puis tu clic sur une autre cellule en colonne B par exemple : feuille déprotégée
peut être que cela le fais

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

Merci Jean-Marcel