ListBox qui s'éloigne de la cellule sélectionnée

Bonjour,

J'ai un fichier avec trois Listbox et choix multiples dedans.

Normalement la liste s'affiche juste a droite de la cellule sélectionnée, même hauteur.

Mais je me rend compte que plus je descend de lignes dans le fichier (presque 9000) plus la listbox s'éloigne de la cellule sélectionnée !!

Et donc j'arrive vite à la configuration ou je choisis ma cellule et ma listbox estcarrément hors champ en bas....

Y a t-il un paramètre à ajuster pour maintenir la position ?

Merci

Hello,

Mais je me rend compte que plus je descend de lignes dans le fichier (presque 9000) plus la listbox s'éloigne de la cellule sélectionnée !!

Effectivement c'est embêtant

Joins ton fichier ou le code utilisé.

Hello,

Voici le code utilisé :

Private Sub ListBox1_Change()
  If bTest Then
    Exit Sub
  End If
  sTemp = ""
  For i = 0 To Me.ListBox1.ListCount - 1
    If Me.ListBox1.Selected(i) Then
      sTemp = sTemp & Me.ListBox1.List(i) & "-"
    End If
  Next
  On Error Resume Next
  Err.Clear
  sTemp = VBA.Left(sTemp, VBA.Len(sTemp) - 1)
  If Err.Number <> 0 Then
    sTemp = ""
  End If
  On Error GoTo 0
  ActiveCell = sTemp

  End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Column = 41 And Target.Row > 2 Then
    With Me.ListBox1
      .MultiSelect = fmMultiSelectMulti
      .ListStyle = fmListStyleOption
      .Height = 150
      .Width = 100
      .Top = ActiveCell.Top
      .Left = ActiveCell.Offset(0, 1).Left
      .Visible = True
    End With
    On Error Resume Next
    'i = Application.WorksheetFunction.Match(Cells(ActiveCell.Row, 2), Worksheets("Donnée").Range("Familles"), 0) - 1
    i = 0
    If Worksheets("Feuil3").Range("O1").Offset(0, i).End(xlDown).Row = 2 Then
      Me.ListBox1.List = Array(Worksheets("Feuil3").Range(Worksheets("Feuil3").Range("O1").Offset(1, i), _
        Worksheets("Feuil3").Range("O1").Offset(0, i).End(xlDown)).Value, "")
    Else
      Me.ListBox1.List = Worksheets("Feuil3").Range(Worksheets("Feuil3").Range("O1").Offset(1, i), _
        Worksheets("Feuil3").Range("O1").Offset(0, i).End(xlDown)).Value
    End If
    On Error GoTo 0
    a = VBA.Split(ActiveCell, "-")
    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
          bTest = True
          Me.ListBox1.Selected(i) = True
          bTest = False
        End If
      Next
    End If
  Else
    Me.ListBox1.Visible = False
  End If

Merci

Hello,

Comme ça il n'y a rien qui me saute aux yeux.

Peux tu faire un fichier anonymisé stp ?

J'ai fait le fichier anonymisé. Juste avec 4000 lignes au lieu des 9000 initialement.

Mais le problème est bien visible dans les trois colonnes surlignées en jaune AO / AP et AQ.

En haut du fichier les listbox restent a coté , mais dès que l'on descend vers le bas du fichier un écart de plus en plus grand se créé entre la cellule sélectionnée et la listbox concernée.

Merci

Bonsoir…

C’est un défaut (de version ?) non traité par Microsoft !

Je n’aime pas corriger des propositions qui me semblent non optimisées donc je présente ma version (incluant des tableaux structurés très faciles à manipuler) et ma façon de gérer ces contrôles ActiveX ListBox adaptable pour la plupart des situations.

Cependant, il y a une liste que j’ai écartée par manque d’informations dans l’exemple proposé.

Si cela convient, il suffira de recopier les tableaux (des 2 feuilles) en adaptant leur nom et en recopiant les macros données dans mon exemple sans changer l’ordre des lignes.

Nota : plus les listes sont longues plus leur rendu visuel diminue en qualité dans la page affichée !

Bonjour,

Merci pour cette solution, qui hélas m'apprend que je ne peux rien y faire visiblement.

Si ce n'est repartir en adaptant ton code.

Le seul bémol, est que dans ta version quand je sélectionne la cellule, la listbox présente la liste complète des choix mais déjà pré-cochés.

Et si j'enlève une sélection cela me garde tout le reste donc a chaque fois je passe mon temps a désélectionner plutôt que à sélectionner un à un les items.

Fabien

Re …

Il te suffisait de corriger les 3 lignes ainsi

For i = 0 To ù1.ListCount - 1: ù1.Selected(i) = 0: Next sachant que 1 c'est pour True et 0 pour False).

Pour une version plus complète et cette fois-ci très optimisée, je passerais plutôt par un formulaire (Userform) dans le fichier joint.

Ainsi ce dernier est fixe quelle que soit la cellule concernée.