Procédure coche par double-clic

Bonjour à tous,

Je sais que des sujets existent à ce sujet, mais malgré ça, je n'ai à aucun moment trouvé de solution à ce problème.

Je n'arrive pas à créer une coche par double clic de plusieurs cellules.

Je pensais pourtant avoir compris le principe de TARGET et d'INTERSECT, mais visiblement non :x

Est-ce que quelqu'un aurait une idée ?

J'ai fait un fichier Excel simple avec 2 onglet dans lequel j'ai la ligne de code permettant la coche simple (qui fonctionne)

Et la seconde qui est sensé fonctionner pour les cellules fusionnées, mais je n'y arrive vraiment pas... (Je sais normalement on évite les cellules fusionnées, mais parfois on a pas le choix).

Je vous remercie par avance pour le tips si vous trouvez une solution.

Voici mon code

'CODE SANS FUSIONS DE CELLULES

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Intersect(Range("B3:B6"), Target) Is Nothing And _
        Intersect(Range("D3:F3"), Target) Is Nothing Then
        Exit Sub
    End If

        'MsgBox
        If ActiveCell.Value = "" Then
            ActiveCell.Value = "X"

        Else
            ActiveCell.Value = ""
        End If

End Sub

'CODE AVEC FUSIONS DE CELLULESPrivate Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Intersect(Range("B3:B4"), Target) Is Nothing And _
        Intersect(Range("D3:I3"), Target) Is Nothing Then
        Exit Sub
    End If

    If Target.MergeCells = True Then
        'MsgBox ("fusionné")
    Else
        'MsgBox ("pas fusionné")
        If ActiveCell.Value = "" Then
            ActiveCell.Value = "X"

        Else
            ActiveCell.Value = ""
        End If

    End If

End Sub

Bonjour Beoden, le forum,

Une piste ici : https://forums.commentcamarche.net/forum/affich-35658977-double-clic-pour-cocher-sur-cellule-fusionn...

Mise en pratique : zone "double-cliquable" B1:I10

Cordialement,

Bonsoir …

Tout simplement avec

Private Sub Worksheet_BeforeDoubleClick(ByVal R As Range, Cancel As Boolean)
   If Intersect(R, [B1:I10]) Is Nothing Then Exit Sub
   R(1, 1) = IIf(R(1, 1) = "", "X", ""): [A1].Select 'ou autre que X
End Sub

Nota : R(1,1) désigne la première cellule d’une Plage nommée R.

Re,

Bonsoir Ordonc

Tout simplement

effectivement, c'est beaucoup plus digeste,

Je n'avais même pas chercher à simplifier...

Bien joué,

[EDIT] pourquoi le [A1].select ?.....on peut s'en passer avec Cancel=True....

Cordialement,

Re…

Merci xorsankukai pour ton appréciation . Je déplore que peu, voire personne, autre que moi, n’utilise cette tournure R(x, y) (où R désigne une plage) fonctionnant de façon analogue à Cells(x, y) et qui supplante très avantageusement des .Offset(-x, -y) !

Whaaaa, Bravo ! Le code est sacrément épuré !

Par contre, étant néophyte, j'avoue avoir du mal à comprendre de R(x, y) surtout dans mon cas, le R(1,1) est censé renvoyer la cellule B1 (1er cellule de la plage indiquée), donc pourquoi toutes les autres cellules fonctionnent pour la coche ?

Par ailleurs, il est possible dans un même "BeforeDoubleClic" de sélectionner 2 plages séparées cochables ? (par exemple B1:I2 et C6:H10) ?

Merci infiniment pour le coup de main en tout cas

Salut,

Ordonc t'a donné la solution, regardes ce que tu as quand tu tapes la fonction Intersect.

Donc à ton avis on doit faire comment ?

Pour ma part je préfère utiliser les adresses et des Select Case je pense que c'est plus parlant au niveau du code.

Mais comme je dis toujours cela n'engage que mes pensées.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' // Si j'utilise des champs nommés par exemple
' // Par exemple  r_Nom correspond à la cellule A1, r_Prenom à la cellule A2

    Select Case Target.Address
        Case R_Nom.Address
            '...
            '...
        Case R_Prenom.Address
            '...
            '...
        Case Else
            '...
            '...
    End Select
End Sub

Bonsoir…

Avec plusieurs plages et pour faire plaisir à xorsankukai (ce n’est pas Faux) :

Dim Pl As Range
Private Sub Worksheet_BeforeDoubleClick(ByVal R As Range, Cancel As Boolean)
    Set Pl = Union([B1:B7], [C5:C7], [D2:H2], [E5:E7], [F5], [D10:I10])
    If Intersect(R, Pl) Is Nothing Then Exit Sub
    R(1, 1) = IIf(R(1, 1) = "", "X", ""): Cancel = 9
End Sub

Pour comprendre R(x, y) : j’ai l’habitude de prendre des noms courts (une lettre pour l’initiale du type de variable Range , 2 ou 3 lettres, la dernière comme index (et qui s’impose dans toute gestion de données) ; x= 1 et y= 1 pour la première cellule d’une plage (objet Range).

Pour des explications approfondies, voir les fichiers joints.

Salut Jean-Paul , « je pense que c'est plus parlant au niveau du code». Encore faut-il parler la langue, non ?

Je vous remercie pour vos retours,

J'ai essayé de manipuler tout ça, et en effet ce code me plait beaucoup car à la fois minimaliste mais très intéressant.

J'en profite pour vous demander, j'ai fait un essai pour autre chose, mais je ne sais pas si le BeforeDoubleClic le permet.

Si je souhaite par exemple (le fichier sera fournit ci-joint si je ne suis pas clair) :

Par double clic ajouter un terme dans certaines cellules, j'ai pris la date ici, en [C1:E1] fusionnées, en C2 et en [D3:E3] fusionnées.

Et ajouter des coches des cellules A5 à A10.

J'ai donc créé deux plage P1 et P2 pour bien séparer les 2 fonctions, ma

Mais je n'arrive qu'à effectuer l'une des deux tâches.

(Ici la date fonctionne mais pas la coche).

J'ai écrit le code suivant :

Dim P1 As Range
Dim P2 As Range

Private Sub Worksheet_BeforeDoubleClick(ByVal R As Range, Cancel As Boolean)

    Set P1 = Union([C1:E1], [C2], [D3:E3])
    Set P2 = Range("A5:A10")

    If Intersect(R, P1) Is Nothing Then Exit Sub
    R(1, 1) = IIf(R(1, 1) = "", Date, ""): Cancel = 9

    If Intersect(R, P2) Is Nothing Then Exit Sub
    R(1, 1) = IIf(R(1, 1) = "", X, ""): Cancel = 9

End Sub

Me manque t-il quelque chose pour que cela fonctionne ou est-ce que la procédure BeforeDoubleClic ne le permet pas ?

Encore merci pour ce système de plages c'est hyper intéressant !

Et merci d'avance pour vos réponses :)

Bonjour à tous,

En supprimant les Exit Sub, cela fonctionne....

Dim P1 As Range
Dim P2 As Range

Private Sub Worksheet_BeforeDoubleClick(ByVal R As Range, Cancel As Boolean)
    Set P1 = Union([C1:E1], [C2], [D3:E3])
    Set P2 = Range("A5:A10")
     If Not Intersect(R, P1) Is Nothing Then R(1, 1) = IIf(R(1, 1) = "", Date, ""): Cancel = 9
     If Not Intersect(R, P2) Is Nothing Then R(1, 1) = IIf(R(1, 1) = "", "X", ""): Cancel = 9
End Sub

Cordialement,

Alors en effet, les "EXIT SUB" posaient problème, mais en les retirant tous, ça ne fonctionnait pas.

J'en ai laissé un en fin de procédure, et là ça fonctionne...

Si quelqu'un a l'explication à tout cela parce que là ça m'échappe un peu

Dim P1 As Range
Dim P2 As Range

Private Sub Worksheet_BeforeDoubleClick(ByVal R As Range, Cancel As Boolean)

    Set P1 = Union([C1:E1], [C2], [D3:E3])
    Set P2 = Range("A5:A10")

        If Not Intersect(R, P1) Is Nothing Then
           R(1, 1) = IIf(R(1, 1) = "", Date, ""): Cancel = 9

        If Not Intersect(R, P2) Is Nothing Then
           R(1, 1) = IIf(R(1, 1) = "", "X", ""): Cancel = 9

     Exit Sub

End Sub

Je reviens sur ma propre réponse, ce qui fonctionne parfaitement, c'est cette forme. Si quelqu'un a mieux à proposer, sinon tout est nickel.

Dim P1 As Range
Dim P2 As Range

Private Sub Worksheet_BeforeDoubleClick(ByVal R As Range, Cancel As Boolean)

    Set P1 = Union([C1:E1], [C2], [D3:E3])
    Set P2 = Range("A5:A10")

        If Not Intersect(R, P1) Is Nothing Then
           R(1, 1) = IIf(R(1, 1) = "", Date, ""): Cancel = 9
        End if

        If Not Intersect(R, P2) Is Nothing Then
           R(1, 1) = IIf(R(1, 1) = "", "X", ""): Cancel = 9
        End if

End Sub

Sujet en résolu :)

Re,

Heu....

 If Not Intersect(R, P1) Is Nothing Then
           R(1, 1) = IIf(R(1, 1) = "", Date, ""): Cancel = 9
        End if

équivaut à

If Not Intersect(R, P1) Is Nothing Then R(1, 1) = IIf(R(1, 1) = "", Date, ""): Cancel = 9

non ?

Qu'est-ce qui ne fonctionne pas dans le fichier que je t'ai joint ?

Cordialement,

Salut,

C'est le b.a.-ba du langage me semble-t-il

' // Ca c'est Glop
If Not Intersect(R, P1) Is Nothing Then R(1, 1) = IIf(R(1, 1) = "", Date, ""): Cancel = 9
' // Ca c'est Glop 
If Not Intersect(R, P1) Is Nothing Then  _
R(1, 1) = IIf(R(1, 1) = "", Date, ""): Cancel = 9

' // Ca c'est pas Glop
If Not Intersect(R, P1) Is Nothing Then 
R(1, 1) = IIf(R(1, 1) = "", Date, ""): Cancel = 9

Re Bon Jour …

Comme tu es curieux, je te propose une autre idée : non pas changer les cellules une par une comme le fait ta macro (que j’écris à ma façon d’adepte de la simplicité avec plus de connaissances) :

Private Sub Worksheet_BeforeDoubleClick(ByVal R As Range, Cancel As Boolean)
   Set P1 = Union([C1:E1], [C2], [D3:E3])
   Set P2 = [A5:A10]
   If Not Intersect(R, P1) Is Nothing Then R = IIf(R(1, 1) = "", Date, "")
   If Not Intersect(R, P2) Is Nothing Then R = IIf(R = "", Date, "")
   Cancel = 1
End Sub

mais toutes les cellules d’une plage en même temps, comme ici :

Dim P1 As Range, P2 As Range, C As Range
Private Sub Worksheet_BeforeDoubleClick(ByVal R As Range, Cancel As Boolean)
    Set P1 = Union([C1:E1], [C2], [D3:E3])
    Set P2 = [A5:A10]
    ‘boucle sur chaque cellule
    If Not Intersect(R, P1) Is Nothing Then _
        For Each C In P1: C = IIf(C(1, 1) = "", Date, ""): Next
   If Not Intersect(R, P2) Is Nothing Then _
        For Each C In P2: C = IIf(C= "", Date, ""): Next
   Cancel = 1
End Sub

On peut aussi écrire :

Private Sub Worksheet_BeforeDoubleClick(ByVal R As Range, Cancel As Boolean)
    Set P1 = Union([C1:E1], [C2], [D3:E3])
    Set P2 = [A5:A10]
    If Not Intersect(R, P1) Is Nothing Then For Each C In P1: C = IIf(C(1, 1) = "", Date, ""): Next
    If Not Intersect(R, P2) Is Nothing Then For Each C In P2: C = IIf(C= "", Date, ""): Next
    Cancel = 1
End Sub

Il ne faut pas être surpris s’il manque des « End If ».

Il est intéressant de savoir que la ligne « If … Then … » n’a pas besoin de « End If » quand il n’y a qu’une éventualité.

Dans « Then _ », le « _ » indique que l’action est complexe. C’est encore intéressant pour ne pas avoir de lignes trop longues à décortiquer en détail.

Bonne continuation dans tes explorations …