Case a cocher multi chiffres
Résolu
mic6259
Messages postés
371
Statut
Membre
-
mic6259 Messages postés 371 Statut Membre -
mic6259 Messages postés 371 Statut Membre -
Bonjour a tous
Selon la pièce jointe dont j'ai trouvé cette astuce, serait-il possible d'avoir a chaque clique dans une cellule a1: a10 d'avoir le chiffre 1 en cliquant une fois ou 2 en cliquant 2 fois et 3 en cliquant 3 fois, et quand on reviens sur a1 par exemple et que le chiffre soit 2 la cellule soit vide.
Merci beaucoup
https://cjoint.com/c/HFyouGfmYi8
Selon la pièce jointe dont j'ai trouvé cette astuce, serait-il possible d'avoir a chaque clique dans une cellule a1: a10 d'avoir le chiffre 1 en cliquant une fois ou 2 en cliquant 2 fois et 3 en cliquant 3 fois, et quand on reviens sur a1 par exemple et que le chiffre soit 2 la cellule soit vide.
Merci beaucoup
https://cjoint.com/c/HFyouGfmYi8
4 réponses
Bonjour,
je ne sais pas si j'ai bien compris, en ajoutant une colonne peut être
colle ce code dans les propriétés de ta feuille (clic droit sur l'onglet de ta feuille/visualiser le code) et colle ce code
teste le entre les cellules A1 et A10 voir
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
If Target(1, 2) = 3 Then Target.Value = Target.Value - 1
If Target.Value = 0 Then Range(Target(1, 1), Target(1, 2)) = ""
If Target.Value <= 3 And Target(1, 2) = "" Then Target.Value = Target.Value + 1
If Target.Value = 3 Then Range(Target(1, 1), Target(1, 2)) = 3
End If
End Sub
je ne sais pas si j'ai bien compris, en ajoutant une colonne peut être
colle ce code dans les propriétés de ta feuille (clic droit sur l'onglet de ta feuille/visualiser le code) et colle ce code
teste le entre les cellules A1 et A10 voir
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
If Target(1, 2) = 3 Then Target.Value = Target.Value - 1
If Target.Value = 0 Then Range(Target(1, 1), Target(1, 2)) = ""
If Target.Value <= 3 And Target(1, 2) = "" Then Target.Value = Target.Value + 1
If Target.Value = 3 Then Range(Target(1, 1), Target(1, 2)) = 3
End If
End Sub
Bonjour Mike-31
Super c'est çà qu'il me faut, mais n'y aurait-il pas un moyen de cliquer plusieurs fois sur la même cellule pour changer le nombre, car il faut a chaque fois changer de cellule et revenir dessus et modifier?
Serait-il possible, plutôt sur la ligne 1 au lieu de la colonne A?
Merci pour ce code
Cordialement
Super c'est çà qu'il me faut, mais n'y aurait-il pas un moyen de cliquer plusieurs fois sur la même cellule pour changer le nombre, car il faut a chaque fois changer de cellule et revenir dessus et modifier?
Serait-il possible, plutôt sur la ligne 1 au lieu de la colonne A?
Merci pour ce code
Cordialement
Re,
si bien sur avec un double clic par exemple
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
If Target(1, 2) = 3 Then Target.Value = Target.Value - 1
If Target.Value = 0 Then Range(Target(1, 1), Target(1, 2)) = ""
If Target.Value <= 3 And Target(1, 2) = "" Then Target.Value = Target.Value + 1
If Target.Value = 3 Then Range(Target(1, 1), Target(1, 2)) = 3
End If
End Sub
ou avec un clic droit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
si bien sur avec un double clic par exemple
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
If Target(1, 2) = 3 Then Target.Value = Target.Value - 1
If Target.Value = 0 Then Range(Target(1, 1), Target(1, 2)) = ""
If Target.Value <= 3 And Target(1, 2) = "" Then Target.Value = Target.Value + 1
If Target.Value = 3 Then Range(Target(1, 1), Target(1, 2)) = 3
End If
End Sub
ou avec un clic droit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Bonjour,
Comme ceci:
ou comme cela:
Comme ceci:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
If Target.Value > 2 Then Exit Sub
Range(Target.Address) = Range(Target.Address) + 1
Range("B1").Select
End If
End Sub
ou comme cela:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
If Target.Value > 2 Then
Target.Value = ""
Else
Range(Target.Address) = Range(Target.Address) + 1
End If
End If
Range("B1").Select
End Sub
