Problème avec un champ de sélection à choix multiple

**Lucien1994** · 24/05/2017, 08h40

Bonjour à toutes, et à tous,

J'ai un tableau avec 12 colonnes et 8 lignes, qui représente un suivis du travail des collaborateurs. J'ai inséré dans ce tableau des listes déroulantes simples (choix de l'état du poste, bon, pas bon, à refaire), puis des cases à cocher (choix de l'endroit, sud, est, ouest, nord). Et enfin

- J'ai mis une macro permettant d'avoir une liste à choix multiple, pour choisir quel collaborateur est présent et une seconde pour choisir quelles tâches ils ont effectué. J'ai un problème d'affichage, quand je sélectionne un ou plusieurs éléments de cette liste, ma feuille Excel "scroll down" afin de mettre le premier élément de la liste tout en haut du classeur excel. (En simple, quand je clique sur la cellule H10 ma liste s'affiche et je vois encore tout le tableau donc de A1 à N14, une fois que je clique sur un élément de ma liste, la feuille excel "scroll down" jusqu'à la cellule H10. Ainsi je dois à chaque fois remonter au haut de ma feuille excel afin de voir tout mon tableau.) -

Voilà, premièrement je vous remercie de m'avoir lus et suis curieux de savoir si quelqu'un a déjà eu ce problème et s'il peut m'aider.

Problème de code ou d'affichage excel ?

Cordialement,

Lucien

**riaolle** · 24/05/2017, 11h59

Bonjour et bienvenue au forum !
Pourrais-tu nous donner le code associé à ta liste à choix multiples ? Il y a peut-être des éléments de réponse dans ce code.

**Lucien1994** · 24/05/2017, 12h19

Salut ! Oui, le voici :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
Option Explicit
 
Dim interne As Boolean
 
Private Sub DTPicker1_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)
 
End Sub
 
Private Sub LbxVille_Change()
    Dim ch As String, i As Long, sep As String
    If Not interne Then
        ch = ""
        sep = [Séparateur]
        For i = 0 To LbxVille.ListCount - 1
            If LbxVille.Selected(i) = True Then ch = ch & sep & LbxVille.List(i)
        Next i
        ch = Mid(ch, Len(sep) + 1)
        ActiveCell = ch
    End If
End Sub
 
Private Sub LbxVille_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
' un clic droit désélectionne ou sélectionne l'ensemble de la liste
    Dim i As Long, cpt As Long, state As Boolean
    If Button = xlSecondaryButton Then  ' si clic-droit
        ' nb sélections
        For i = 0 To LbxVille.ListCount - 1
            If LbxVille.Selected(i) Then cpt = cpt + 1
        Next i
        ' si aucune sélection sélectionner tout
        ' sinon désélectionner tout
        If cpt = 0 Then state = True Else state = False
        interne = True    ' palliatif, EnableEvents ne marche pas
        For i = 0 To LbxVille.ListCount - 1
            LbxVille.Selected(i) = state
        Next i
        interne = False
    End If
    LbxVille_Change
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim ch As String, ch2 As String, pos As Long, i As Long
    Dim plage, nomListe, numListe As Long, topIndex As Boolean
    ' plages avec sélection multiple sur cette feuille
    plage = Array("H5:H100", "M5:M100")
    ' nom des listes dans la feuille Listes (en liaison avec les plages définies au-dessus)
    nomListe = Array("Ville", "Prénom")
    ' plage concernée ?
    For numListe = 0 To UBound(plage)
        If Not Intersect(Target, Range(plage(numListe))) Is Nothing Then Exit For
    Next numListe
 
    If numListe <= UBound(plage) Then ' si plage de liste existant
        ' initialiser listbox
        LbxVille.ListFillRange = "Listes!" & Worksheets("Listes").Range(nomListe(numListe)).Address          ' A2:A17" ' [Listes!Ville].Address
        LbxVille.Top = Target.Offset(1, 0).Top
        LbxVille.Left = Target.Offset(0, 1).Left
 
        interne = True    ' palliatif, EnableEvents ne marche pas
        ch = ActiveCell
        ch2 = [Séparateur] & ch & [Séparateur]
        topIndex = False
        ' sélectionner selon contenu cellule
        For i = 0 To LbxVille.ListCount - 1
            If InStr(ch2, [Séparateur] & LbxVille.List(i) & [Séparateur]) > 0 Then
                ' l'item a été trouvé dans la cellule
                LbxVille.Selected(i) = True
                If Not topIndex Then
                    LbxVille.topIndex = i    ' le 1er sélectionné doit être visible dans la textbox
                    topIndex = True
                End If
            End If
        Next i
        interne = False
        ' afficher textbox
        LbxVille.Visible = True
    Else
        ' ne plus afficher la textbox
        LbxVille.Visible = False
    End If
End Sub
 
Sub reinit()
    Application.EnableEvents = True
End Sub