ListBox sur cellule active

Version imprimable

06/11/2019, 17h00
TchiotPols

1 pièce(s) jointe(s)

ListBox sur cellule active

Bonjour,
Je suis toujours autodidacte et là j'ai un problème de compréhension de texte !
J'ai récupéré une macro dans un fichier Excel, pour afficher un TextBox (dont les valeurs sont présentées sous forme de listing) lorsque l'on clique dans une cellule d'une plage donnée (ici "D3 : D6").
Par un clic gauche, le TextBox s'affiche alors sous la cellule cliquée et présente à l'utilisateur une liste de données ("observations") dans laquelle il peut sélectionner une donnée pour venir l'afficher dans cette cellule à la suite de la ou des valeurs déjà présentes ou pas. Lors de l'affichage du TextBox, dans la liste proposée, sont surlignsée(s) la ou les valeurs déjà présente(s) dans la cellule permettant ainsi à l'utilisateur de voir de suite ce qui manque dans la cellule pour que le dossier en final soit clôturé.
Dans le code, derrière l'apostrophe est inscrit le commentaire du rédacteur du code original.
Dans le code, entre 2 lignes de signes "=" mes problèmes de compréhension.
Je ne comprend pas pourquoi le "UBound(plage)" reste à zéro alors qu'il devrait être égal à 4 puisque la plage concernée fait 4 lignes avec 1 valeurs dans chacune des lignes ??
Je ne comprend pas non plus les variables "interne" et "state"
Si quelqu'un pouvait m'expliquer ces deux incompréhensions et corriger éventuellement le code pour que ça fonctionne, je lui en serai très reconnaissant.
Ainsi en voyant fonctionner la macro je comprendrai encore mieux son code.
Par avance merci.
J'ai mis le fichier en pièce jointe.
07/11/2019, 11h21
Phil Free

Bonjour,

pour commencer, je n'ouvre pas les pièces jointes . Ceci étant dit :

-comment est dimensionné ta variable plage ?
-comment la remplis tu ?

poste juste la partie du code qui pose problème .

A+

Bonjour Phil Free

Voici le code. Personnellement à partir du lien sur le forum j'arrive à ouvrir le fichier. C'est un fichier tout simple avec le code ci-dessous
Entre 2 lignes de signes "=" c'est ce que je ne comprends pas.
Ne pas oublier que c'est une récupération de code qui fonctionnait que j'ai adapté à mon besoin et je suis un autodidacte qui apprend en épluchant et en regardant comment fonctionnent les codes.

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
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
87
88
89
90
91
92
93
94
95
Option Explicit
 
Dim interne As Boolean
Sub LbxObservations_Change()
    Dim ch As String, i As Long, sep As String
    '==================================
    'interne ??
    '==================================
    If Not interne Then
        ch = ""
        sep = [separateur]
        For i = 0 To LbxObservations.ListCount - 1
            If LbxObservations.Selected(i) = True Then ch = ch & sep & LbxObservations.List(i)
        Next i
        ch = Mid(ch, Len(sep) + 1)
        ActiveCell = ch
    End If
End Sub
 
Sub LbxObservations_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
' un clic gauche désélectionne ou sélectionne l'ensemble de la liste
    Dim i As Long, cpt As Long, state As Boolean
    'Dim LbxObservations
    If Button = xlSecondaryButton Then  ' si clic-droit
        ' nb sélections
        For i = 0 To LbxObservations.ListCount - 1
            If LbxObservations.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 LbxObservations.ListCount - 1
            LbxObservations.Selected(i) = state
        Next i
        interne = False
    End If
    LbxObservations_Change
End Sub
Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim ch As String, ch2 As String, pos As Long, i As Long
    Dim nomListe, numListe As Long, topIndex As Boolean
    Dim plage
    Dim LbxObservations
    ' plage avec sélection multiple sur cette feuille
    plage = Array("D3:D6")
    'initialisation du nom de la liste "observaions" de la feuille "Glossaire" (en liaison avec la plage définie au-dessus)
    nomListe = Array("observations")
    ' plage concernée ?
    '===================================================
    'le UBound(plage) reste toujours à 0
    'Normalement il devrait être = 4 ??
    'Lorsque je redéfinis la variable "plage" de cette façon : plage = ActiveSheet.Range("D3:D6"), le UBound (plage) passe bien à 4, mais ça bugue quand même après
    '===================================================
    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
        '===============================================
        'numListe est à 0 = bug sur la ligne suivante
        'cause : UBound = 0
        '===============================================
        LbxObservations.ListFillRange = "Glossaire!" & Worksheets("Glossaire").Range(nomListe(numListe)).Address
        LbxObservations.Top = Target.Offset(0, 1).Top
        LbxObservations.Left = Target.Offset(0, 1).Left
 
        interne = True    ' palliatif, EnableEvents ne marche pas
        ch = ActiveCell
        ch2 = [separateur] & ch & [separateur]
        topIndex = False
        ' sélectionner selon contenu cellule
        For i = 0 To LbxObservations.ListCount - 1
            If InStr(ch2, [separateur] & LbxObservations.List(i) & [separateur]) > 0 Then
                ' l'item a été trouvé dans la cellule
                LbxObservations.Selected(i) = True
                If Not topIndex Then
                    LbxObservations.topIndex = i    ' le 1er sélectionné doit être visible dans la textbox
                    topIndex = True
                End If
            End If
        Next i
        interne = False
        ' afficher textbox
        LbxObservations.Visible = True
    Else
        ' ne plus afficher la textbox
        LbxObservations.Visible = False
    End If
End Sub
 
Sub reinit()
    Application.EnableEvents = True
End Sub

Merci pour ton aide en espérant que tu pourras ouvrir le fichier.
A+

07/11/2019, 15h45
Phil Free
non je n'ai pas dit que je ne peux pas ouvrir la pièce jointe mais que je n'ouvre pas les pièces jointe !!!

concernant ta question... mixte étrange !!!
Code:

1 2 3 4 Dim plage ' plage avec sélection multiple sur cette feuille plage = Array("D3:D6")
Comme tu utilises Array() l'option base est a 0 par défaut du coup ubound(plage) te renvois l'indice le plus élevé de ta variable plage, devenu de fait tableau Array. Donc dans ton cas le premier indice du tableau est 0 ! si Plage était vide tu aurais une erreur d’exécution 13 en retour !!! donc il y bien une valeur dans plage dont l'indice est 0 !

pour le teste ajoute :

Code:

Msgbox Plage(0)

juste après

Code:

plage = Array("D3:D6")

et tu auras comme message D3:D6

Pour attribuer les valeurs d'une plage de cellules à une variable dimensionné en "Non tableau" elle doit être au moins Variant. Ce qui est le cas vu que si on ne spécifie rien, comme tu l'à fais une variable dimensionnée mais non typé sera par défaut en Variant.

Donc ce que tu aurais du écrire c'est

Code:

plage = Range("D3:D6").Value

mais attention dans ce cas on est plus sur une variable tableau dont l'option base est 0(par défaut pour les tableaux array) quand on utilise cette méthode de création de tableau l'option base pour cette variable passe a 1 !

Pour résumer :
Code:

1 2 plage = Array(Range("D3").Value, Range("D4").Value, Range("D5").Value, Range("D6").Value) ubound(plage) 'renvois 3 car plage est un tableau array et que dans ce cas option base est par défaut à 0
et
Code:

1 2 plage = Range("D3:D6").Value ubound(plage) 'renvois 4 car plage est un tableau NON array et que dans ce cas et pour cette variable seulement option base est par défaut à 1
A+
07/11/2019, 16h25
TchiotPols

1er cas :

j'ai bien ajouté la ligne MsgBox plage(0)
et j'ai bien comme réponse : D3 : D6

Code:

plage = Array("D3:D6")

Quand j'ai cette écriture dans le code, le UBound(plage) a la valeur 0.
Je sort de la boucle For ... Next
Le numListe est à 0
sur la ligne :

Code:

LbxObservations.ListFillRange = "Glossaire!" & Worksheets("Glossaire").Range(nomListe(numListe)).Address

J'ai une erreur 424 : Objet requis

2eme cas :

Code:

plage = Range("D3:D6").Value

Quand j'ai cette écriture dans le code, dans la boucle For ... Next
J'ai une erreur 9 : L'indice n'appartient pas à la sélection

Dans les deux cas je suis bloqué.

1 pièce(s) jointe(s)

Bonjour,

Exemple en PJ

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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect([A2:A10], Target) Is Nothing Then
    Me.ListBox1.MultiSelect = fmMultiSelectMulti
    Me.ListBox1.List = Sheets("BD").Range("A2:A28").Value
    a = Split(Target, " ")
    If UBound(a) >= 0 Then
      For i = 0 To Me.ListBox1.ListCount - 1
        If Not IsError(Application.Match(Me.ListBox1.List(i), a, 0)) Then Me.ListBox1.Selected(i) = True
      Next i
    End If
    Me.ListBox1.Height = 150
    Me.ListBox1.Width = 100
    Me.ListBox1.Top = Target.Top
    Me.ListBox1.Left = Target.Left + Target.Width
    Me.ListBox1.Visible = True
  Else
      Me.ListBox1.Visible = False
  End If
End Sub
 
Private Sub ListBox1_Change()
 For i = 0 To Me.ListBox1.ListCount - 1
   If Me.ListBox1.Selected(i) = True Then temp = temp & Me.ListBox1.List(i) & " "
 Next i
 ActiveCell = Trim(temp)
End Sub

Boisgontier

aie aie aie !

ce qu tu veux c'est boucler sur le contenu de tes cellules de la plage D3:D6

En VBA une cellule est un objet et la valeur dans la cellule est une propriété de l'objet. Pour accéder à une propriété d'un objet on est obligé de passer par l'objet

D3:D6 ne sert qu'à identifier les objets cellule. C'est leur adresse. Utiliser cette adresse seule ne sert à rien !!!

quand tu écris : plage = Array("D3:D6") en fait tu n'utilises que l'adresse de tes cellules qui ici n'est rien d'autre qu'une chaîne de caractères. Tu écrirais "bob" en lieu et place ce serait pareil. On ne peu pas !

Range("D3") définit une cellule dont l'adresse est "D3"
Range("D3:D6") définit un groupe de cellules dont l'adresse est "D3:D6"

Range("D3").Value qui permet d’accéder à la propriété valeur de la cellule
Range("D3:D6").value ici cela ne fonctionne pas car on à affaire à plusieurs cellules. De fait il faudra boucler sur ce groupe de cellule pour en obtenir leur valeur propre

pour cela on à plusieurs solutions. la plus commune est qu'on boucle sur les cellules elle même
Code:

1 2 3 4 Dim i As long For i = 3 to 6 msgbox Range("D" & i).Value Next i
ou alors
Code:

1 2 3 4 Dim Cellule As Range For Each Cellule in Range("D3:D6") msgbox Cellule.Value Next
Une des autres solutions c'est de faire comme tu essais de le faire qui est de passer par une variable tableau.
Mais la aussi il y a plusieurs façons :
Code:

1 2 3 4 5 6 7 Dim Plage As Varant , i as long Plage = Range("D3:D6").value For i = 1 to Ubound(Plage) msgbox Plage(i) Next i
Code:

1 2 3 4 5 6 Dim Plage As Variant , i as long Plage = Array(Range("D3").Value, Range("D4").Value, Range("D5").Value, Range("D6").Value) For i = 0 to Ubound(Plage) msgbox Plage(i) Next i
Code:

1 2 3 4 5 6 7 8 9 10 11 Dim Plage() As String , i as long, j As Long Redim Plage(Range("D3:D6").Rows.Count) For i = 0 to Ubound(Plage) 'on rempli le tableau Plage(i) = Range("D" & i +3).Value Next i For j = 0 to Ubound(Plage) 'on parcourt le tableau msgbox Plage(j) Next j
etc etc etc...

on est quand même sur des bases que je ne devrais pas avoir t'expliquer !!! il vas te falloir trouver les Tutos qui vont bien et ce site est une mine d'or pour ça !

Donc je m’arrête la.

A+

PS : Ah oui et pour ce que tu dis :

Citation:

Envoyé par TchiotPols

2eme cas :

Code:

plage = Range("D3:D6").Value

Quand j'ai cette écriture dans le code, dans la boucle For ... Next
J'ai une erreur 9 : L'indice n'appartient pas à la sélection

Dans les deux cas je suis bloqué.

c'est que tu n'as pas bien lu mon précédent message.

08/11/2019, 14h43
TchiotPols

Bonjour,
Tout d'abord merci de prendre de votre temps pour me répondre. C'est très sympa de m'avoir aidé même si je m'aperçois que j'ai encore du taf pour macroter correctement. Mais ça me plait et j'aime ça. J'ai démarré trop tard, mais maintenant j'ai plus de temps.

Merci à Pjil Free pour sa patience et ses conseils.
Merci à boisgontierjacques pour son fichier qui est exactement ce que je recherche. Avec une macro qui fonctionne, je vais pouvoir décortiquer cela et ainsi mieux comprendre.

Je vous souhaite une bonne continuation et encore merci

1 pièce(s) jointe(s)

pour le plaisir ...

Bonsoir

Si cela te plait … une autre proposition se rapprochant de ton premier exemple mais avec l’utilisation de tableaux structurés (ListObjects) qui procurent un très grand nombre d’avantages (très peu utilisés ici mais pouvant être appréciés dans un contexte plus développé).
Dans la fenêtre des codes de la feuille :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Dim C As Range, i As Long, T As String, L As Byte
Sub Worksheet_SelectionChange(ByVal R As Range)
  Lt.List = [Tl].Value: Lt.Height = 12 * Lt.ListCount 'initialisation de la liste à partir du tableau Tl (autre feuille)
  Lt.Top = R(1, 2).Top:  Lt.Left = R(1, 2).Left    'position de la liste          
  Lt.MultiSelect = 1: Lt.Height = 14 * Lt.ListCount: Lt.Visible = 0  'avec multisélection, hauteur ajustée et liste cachée
  If Not Intersect(R, [Bd].Columns(3)) Is Nothing And R.CountLarge = 1 Then 'sélection d'une cellule colonne 3  du tableau Bd
     Set C = R: Lt.Visible = 1 'sauvegarde du Range  et affichage de la liste
  End If
End Sub
Private Sub Lt_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Button = 1 Then  'clic bouton gauche pour sélectionner
     T = "": L = 0
     For i = 0 To Lt.ListCount - 1
        If Lt.Selected(i) Then T = T & Lt.List(i) & vbLf: L = L + 1    'initialisation du texte (avec retour à la ligne et nombre de retours
    Next
  Else   'sinon (clic bouton droit) por transmettre le texte
      Application.EnableEvents = 0 'Indispensable  (pas d'appels récursifs)
      C = T:  Rows(C.Row).RowHeight = L * 14 + 14: C(1, 0).Select  'avec ajustement de la hauteur de la ligne
      Application.EnableEvents = 1 'obligatoire (sous peine de neutraliser l'effet des évènements)
      Lt.Visible = 0 'liste recachée
  End If
End Sub

11/11/2019, 16h58
TchiotPols

Bonsoir Ordonc
Merci pour cette proposition très intéressante. Avec un code court de surcroit. Le problème est qu'après la sélection des propositions, elle vient écraser ce qui était déjà présent dans la cellule active. Les sélections dans la ListBox doivent venir s'afficher à la suite de l'existant et non pas écraser le ou les valeurs déjà affichées dans cette cellule.
C'est un code un peu plus sophistiqué pour moi mais je vais voir si je peux de moi-même essayer de corriger cela. En tous les cas merci pour ce code que je vais garder précieusement.:D