XL 2010 VBA - Insérer texte par double clics

Hasco

XLDnaute Barbatruc

Repose en paix

• 10 Janvier 2022

• #2

bonjour,

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

Cordialement

 

Vote positif 0 Vote négatif

J

JM27

XLDnaute Barbatruc

• 10 Janvier 2022

• #3

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

 

Vote positif 0 Vote négatif

T

tchi456

XLDnaute Occasionnel

• 10 Janvier 2022

• #4

Bonjour Jean-Marcel,

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

Cordialement,

Thierry

 

Vote positif 0 Vote négatif

T

tchi456

XLDnaute Occasionnel

• 10 Janvier 2022

• #5

Bonjour Hasco,

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

Cordialement,

Thierry

 

Vote positif 0 Vote négatif

Hasco

XLDnaute Barbatruc

Repose en paix

• 10 Janvier 2022

• #6

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

 

Vote positif 0 Vote négatif

T

tchi456

XLDnaute Occasionnel

• 10 Janvier 2022

• #7

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!

 

Vote positif 0 Vote négatif

T

tchi456

XLDnaute Occasionnel

• 10 Janvier 2022

• #8

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

 

Vote positif 0 Vote négatif

J

JM27

XLDnaute Barbatruc

• 10 Janvier 2022

• #9

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: 10 Janvier 2022

Vote positif 0 Vote négatif

Solution

T

tchi456

XLDnaute Occasionnel

• 10 Janvier 2022

• #10

JM27 à dit:

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

Cliquez pour agrandir...

Merci Jean-Marcel

 

Vote positif 0 Vote négatif