Ajouter un X par simple clic

[hassan.zer]

Bonsoir, j'ai réussi grace au forum, a faire un X grace a un double clic, et je souhaiterai faire la meme chose mais sur des cellulles séparés, voici le fichier joint, merci.

 

[ROGER2327]

Re : Ajouter un X par simple clic

Bonjour hassan.zer

Essayez ceci :

[COLOR="DarkSlateGray"][B]Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim pl As Range
   With Target
      Set pl = Application.Intersect(Rows(.Row), Range("F6:I17,L6:L17,N6:N17"))
      If Not pl Is Nothing Then
         Cancel = True
         If .Value = "" Then
            pl.ClearContents
            .Value = "x"
            Cells(.Row, 10).Value = Date
         Else
            .Value = ""
            Cells(.Row, 10).Value = ""
         End If
      End If
   End With
End Sub[/B][/COLOR]

ROGER2327
#3071

 

[poilamonnez]

Re : Ajouter un X par simple clic

Bonjour Roger et Hassan.

Merci Roger, super, je cherchais justement un code dans ce genre.
et je pense avoir enfin compris la commande Intersect.....

Je me suis permis une petite modif pour éviter de faire des croix entres les colonnes. 🙄

@ bientôt

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim pl As Range
   With Target
      Set pl = Application.Intersect(Range(.Address), Range("F6:I17,L6:L17,N6:N17"))
      If Not pl Is Nothing Then
         Set pl = Application.Intersect(Rows(.Row), Range("F6:I17,L6:L17,N6:N17"))
         If .Value = "" Then
            pl.ClearContents
            .Value = "x"
            Cells(.Row, 10).Value = Date
         Else
            .Value = ""
            Cells(.Row, 10).Value = ""
         End If
   End If
   End With
   Cancel = True
End Sub

 

[ROGER2327]

Re : Ajouter un X par simple clic

Re...

Bonjour poilamonnez.

Votre proposition est judicieuse et, après réexamen de la demande de notre ami, peut-être plus proche de ce qu'il souhaite.

Vous pouvez aussi écrire

[COLOR="DarkSlateGray"][B]Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim pl As Range
   With Target
      Set pl = Application.Intersect(Rows(.Row), Range("F6:I17,L6:L17,N6:N17"))
      If Not pl Is Nothing Then
         If Not Intersect(Target, pl) Is Nothing Then
            If .Value = "" Then
               pl.ClearContents
               .Value = "x"
               Cells(.Row, 10).Value = Date
            Else
               .Value = ""
               Cells(.Row, 10).Value = ""
            End If
         End If
      End If
   End With
   Cancel = True
End Sub[/B][/COLOR]

qui, me semble-t-il, fait exactement la même chose.
Ce n'est pas plus simple, mais ça évite d'écrire deux fois le paramètre "F6:I17,L6:L17,N6:N17".

S'il revient un jour, notre ami n'aura que l'embarras du choix.​

ROGER2327
#3084