XL 2010 VBA - Insérer texte par double clics

tchi456

XLDnaute Occasionnel
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:

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

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

Hasco

XLDnaute Barbatruc
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

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

XLDnaute Occasionnel
RE,

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

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

XLDnaute Accro
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

VB:
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
 
Dernière édition:

tchi456

XLDnaute Occasionnel
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

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

Discussions similaires

Réponses
4
Affichages
208