Évènement lié au click avec la souris

Version imprimable

11/11/2010, 00h42
hockey123

Évènement lié au click avec la souris

Bonjour,
Contexte:
J'ai des chiffres de 1 à 42 dans le Range("B5:C25").
J'ai un Range("E5:E10") qui devrait être un tableau intitulé choix.
Problématique:
Il faut que lorsque l'usager click avec sa souris sur un chiffre dans le premier range, celui-ci se retrouve en ordre croissant dans le tableau choix.
L'usager doit pouvoir sélectionner jusqu'à 6 chiffres.

J'ai tenté des trucs avec Worksheet_SelectionChange, mais je n'arrive pas à rien de très concret..
Merci pour toute aide !!
11/11/2010, 08h07
babaothe

Citation:

Envoyé par hockey123

J'ai tenté des trucs avec Worksheet_SelectionChange, mais je n'arrive pas à rien de très concret..

Salut
Montre le code que tu as tenté
Il nous permettra entre autres de mieux comprendre ce que veut exactement dire :

Citation:

J'ai un Range("E5:E10") qui devrait être un tableau intitulé choix.
11/11/2010, 10h35
Pierre Fauconnier

Bonjour

Citation:

Envoyé par hockey123

...
Il faut que lorsque l'usager click avec sa souris sur un chiffre dans le premier range, celui-ci se retrouve en ordre croissant dans le tableau choix.
...

Personnellement, je ne comprends pas le sens de cette phrase.

[EDIT] Heu, finalement, j'ai pigé... [/EDIT]

Salut Hockey
Essaye ca:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim L As Integer, Valeur As Integer, i As Integer, j As Integer
Dim Cible As Variant
Dim Selection() As Double
If Not Intersect(Target, Range("B5:C25")) Is Nothing Then
    x = 0
    For L = 5 To 10
        If Not Cells(L, 5) = "" Then
            ReDim Preserve Selection(x)
            Selection(x) = Cells(L, 5).Value
            x = x + 1
        End If
    Next L
    If UBound(Selection) = 5 Then
        MsgBox "6 codes ont déjà été selectionnés." & Chr(10) & Chr(10) & _
            "Vous ne pouvez plus rien sélectionner"
        Exit Sub
    End If
    ReDim Preserve Selection(x)
    Selection(x) = Target.Value
    Do
        Valeur = 0
        For i = UBound(Selection) To 1 Step -1
            If Selection(i) < Selection(i - 1) Then
                Cible = Selection(i)
                Selection(i) = Selection(i - 1)
                Selection(i - 1) = Cible
                Valeur = 1
            End If
        Next i
    Loop While Valeur = 1
    For x = 0 To UBound(Selection)
        Cells(x + 5, 5) = Selection(x)
    Next x
End If
End Sub

et dis

Bonjour à tous,

J'ajoute mon petit grain de sel :mrgreen:

L'évènement click n'existe pas pour une feuille mais on peu jouer sur le double click
Procédure à placer dans le module de la feuille en question

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Plg1 As Range, Plg2 As Range, Cl As Range, Verif As Boolean
 
Set Plg1 = Range("B5:C25") '<-- plage source
Set Plg2 = Range("E5:E10") '<-- plage de destination
 
'vérification que la cellule sélectionnée est bien dans la plage source
If Application.Intersect(Target, Plg1) Is Nothing Then
    MsgBox "Sélectionnez un chiffre de 1 à 42 dans la liste"
    Cancel = True
    Exit Sub
End If
 
'vérification que le chiffre n'a pas encore été choisi
If Target.Interior.ColorIndex = 3 Then
    MsgBox "Ce chiffre a déjà été sélectionné, veuillez en choisir un autre."
    Cancel = True
    Exit Sub
End If
 
'insertion du chiffre sélectionné dans la plage de destination
For Each Cl In Plg2
    If Cl = "" Then
        Cl = Target.Value
        Verif = True
        Exit For
    End If
Next
 
'vérification si déjà 6 chiffres choisis
If Verif = True Then
    Verif = False
Else
    MsgBox "Vous avez déjà choisi 6 chiffres"
    Cancel = True
    Exit Sub
End If
 
'tri de la plage de destination
Plg2.Sort Key1:=Range("E5"), Order1:=xlAscending
 
'coloriage dans la plage source du chiffre choisi
Target.Interior.ColorIndex = 3
Cancel = True
 
End Sub

Reste à gérer le reset des plages

Et une proposition

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
If Not Intersect(Target, Range("B5:C25")) Is Nothing Then
    If Target.Count = 1 Then
        If Application.CountBlank(Range("E5:E10")) > 0 Then
            If Application.CountIf(Range("E5:E10"), Target.Value) = 0 Then
                Application.ScreenUpdating = False
                Range("E10").Value = Target.Value
                Range("E5:E10").Sort key1:=Range("E5"), Order1:=xlAscending, Header:=xlNo
            End If
        End If
    End If
End If
End Sub

Salut.

Pour éviter les différents tests, je propose ceci, partant du fait que si E10 est vide, c'est qu'on n'a pas tout rempli, sinon c'est qu'on a tout rempli

Code:

1
2
3
4
5
6
7
8
9
10
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Range("B5:C25"), Target) Is Nothing Then
      If IsEmpty(Range("e10")) Then
        Range("e10") = Target.Value
        Range("e5:e10").Sort key1:=Range("e5"), order1:=xlAscending, Header:=xlNo
      Else
      MsgBox "Tout est rempli"
    End If
  End If
End Sub

11/11/2010, 18h25
mercatog

Bonjour Pierre,
Sauf qu'il faudrait encore tester l'inexistence du nombre cliqué dans la plage (éviter les doublons).
Edit

Bonjour Mercatog,

Pour la sélection de plusieurs cellules, on peut y pallier sans test en utilisant Target.Cells(1,1), par exemple (car il y aura problème lors du test d'existence éventuelle de la valeur, voir ta deuxième remarque).

Pour ce qui est des doublons, je ne vois pas cette contrainte dans l'énoncé du problème initial, même si à la relecture, je peux comprendre qu'il s'agit d'une grille de lotto à remplir.

Si cette contrainte existe effectivement, on devra faire un test, que je réaliserai alors avec EVALUATE ( On arrive alors toi et moi à des solutions sensiblement similaires, et nos "productions" auront alors valeur pédagogique... ;) )
Code:

1 2 3 4 5 6 7 8 9 10 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Range("B5:C25"), Target) Is Nothing Then If IsEmpty(Range("e10")) Then If Evaluate("countif(e5:E10," & Target.Cells(1, 1).Value & ")") = 0 Then Range("e10") = Target.Cells(1, 1).Value Range("e5:e10").Sort key1:=Range("e5"), order1:=xlAscending, Header:=xlNo Else MsgBox "Tout est rempli" End If End If End Sub

16/11/2010, 04h31
hockey123

Merci à tous pour l'aide, j'ai beaucoup appris !