Autres Ligne dans la ListBox lorsque la date change

[francescofrancesco]

Bonjour.

Comme indiqué dans le fichier joint, je peux insérer une ligne pour le nombre d'entrées dans la ListBox, mais uniquement lorsque la date de la colonne B change.

Je n'arrive pas à gérer l'incrémentation de K avec la position Top.
Excel 2003

 

[gbinforme]

Bonjour,
Si tu expliquais le but de ta recherche l'on pourrait sans doute t'aider,
mais apparemment je ne suis pas le seul à ne pas comprendre la démarche.

 

[Nain porte quoi]

Hello,

je confirme, c'est pas clair du tout

 

[francescofrancesco]

Bonsoir.
Voir la deuxième liste.
Le problème est que lorsque l'on fait défiler la liste, les lignes restent fixes et ne suivent pas l'ordre des dates.

 

[Nain porte quoi]

Hello,

Effectivement, c'est un diagnostic classique de rhumatisme temporel aigu.

Objet : Crise d'insubordination gravitationnelle dans la Liste n°2
C'est tout à fait normal. Ce que vous décrivez est un phénomène de stase chronologique inversée.

En gros, les dates ont pris de l'avance pour éviter les bouchons du week-end, tandis que les lignes, plus casanières, ont décidé de s'enraciner dans le pixel pour faire valoir leur droit à la sédentarité. C'est un conflit syndical assez fréquent entre le calendrier et l'interface.

Voici ce que je préconise pour rétablir l'ordre :

- L'approche homéopathique : Versez trois gouttes d'huile essentielle de caféine sur votre écran pour réveiller les lignes léthargiques.

- La méthode forte : Secouez votre moniteur de gauche à droite en criant "Le temps est une illusion, mais le scroll est un devoir !". Cela devrait intimider les dates et les forcer à attendre leurs lignes respectives.

- Le compromis diplomatique : Imprimez la liste, découpez chaque ligne aux ciseaux, et collez-les sur votre écran avec de la pâte à fixe. Là au moins, elles ne bougeront plus, mais au moins elles seront d'accord avec le papier.

Si le problème persiste, c'est probablement que votre souris a le vertige et refuse de descendre plus bas par peur du vide numérique.

Mais revenez nous dire si une des solutions à fonctionnée et aussi si vous vous décidiez à nous expliquer ce que vous voulez faire.

 

[francescofrancesco]

Bonjour,
Pour faire simple et clair, je vais faire défiler les lignes en même temps que la liste.
Merci.

 

[Nain porte quoi]

"Simple" c'est tout a fait exact, par contre "clair " pas du tout, du moins pour moi, j'espère que d'autres arriveront à lire dans vos pensées

 

[Rheeem]

Placez la listbox et ses lignes dans un frame et utiliser le scrollbar de ce dernier pour défiler la liste.
Ta méthode qui consiste à créer des listboxes pour marquer certaines lignes a des limites car on ne peut pas les créer à l'infini,
Dans l'exemple j'ai remplacé les listboxs par des frame qui sont moins pénalisant pour la fiche

 

[francescofrancesco]

Bonjour, super .
Comment modifier le code de la fonction MouseMove de la Listbox ?
Merci.

Private Sub ListBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
On Error Resume Next
'récupère position vertical curseur souris
coordY = Y

'longueur listbox = nombre éléments de la liste x 10px par éléments
longueurlist = ListBox2.ListCount * 10

'hauteur listbox
htlistbox = ListBox2.Height
i2 = Me.ListBox2.ListCount

'transforme position curseur en position éléments de la liste par simple règle de trois
'arrondir à un chiffre rond
yyy = Int(Int(Y * i2 / htlistbox) * 10)

'sélectionne l'élément de la liste par rapport à la position du curseur
ListBox2.ListIndex = yyy / 10

End Sub

 

[Rheeem]

La hauteurs des éléments est en point pas en pixel et change selon le font utilisé pour la calculer automatiquement utiliser IAccessible pour mesurer la hauteur et accHitTest pour récupérer l'élément sous la souris .

pour la hauteur:

    Dim acc As IAccessible, d As Long, h As Long
    Set acc = ListBox2
    acc.accLocation d, d, d, h, 1& '
    ElemHeight = h * 72 / 96

code complet: (je j'ai pas utilisé accHitTest mais un simple Y \ ElemHeight permet de savoir l'élément sous la souris

Private ElemHeight As Single

Private Sub PlacerLignes()
 
Dim Y As Long
Dim val1 As String, val2 As String

Frame1.Height = ListBox2.Height
ListBox2.Height = ListBox2.ListCount * ElemHeight
Frame1.ScrollHeight = ListBox2.Height
Frame1.Width = ListBox2.Width

For Y = 1 To ListBox2.ListCount - 1
  Xval1 = ListBox2.List(Y, 1)
  Xval2 = ListBox2.List(Y - 1, 1)
  If Xval1 <> Xval2 And Xval2 = "" Then
    With Frame1.Controls.Add("Forms.Frame.1")
      .Top = Y * ElemHeight
      .Left = 0
      .Height = 0.68
      .Width = 90
      .Enabled = False
      .SpecialEffect = 0
      .BackColor = vbBlack
      .ZOrder 0
    End With
  End If
Next Y
ListBox2.ZOrder 1
 
End Sub
 
Private Sub ListBox2_Click()
Dim pos As Single
pos = ListBox2.ListIndex * ElemHeight
If (pos < Frame1.ScrollTop) Or (pos > (Frame1.ScrollTop + Frame1.InsideHeight - ElemHeight)) Then
   Frame1.ScrollTop = pos - ElemHeight
End If
  
End Sub

Private Sub ListBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Caption = Y \ ElemHeight
End Sub

Private Sub UserForm_Initialize()
  
  Set f = Sheets("bd")
  Tbl1 = f.Range("A2:B" & f.[A65000].End(xlUp).Row).Value
  ListBox2.List = Tbl1
  If ListBox2.ListCount > 0 Then
    Dim acc As IAccessible, d As Long, h As Long
    Set acc = ListBox2
    acc.accLocation d, d, d, h, 1&
    ElemHeight = h * 72 / 96
  End If
  If ElemHeight = 0 Then
     ElemHeight = 9
  End If
  PlacerLignes
End Sub

 

[francescofrancesco]

Caption = Y \ ElemHeight
Il affiche simplement la position, mais ne sélectionne pas l'élément dans la liste.

 

[Rheeem]

Pour sélectionner un élément affecter son indice à la propriété ListBox2.ListIndex
Attention il ne faut pas supprimer ListBox2_Click ce code maintient la sélection dans la partie visible puisque le défilement est fait par le Frame la listbox n'a pas de scrollbar.

Private Sub ListBox2_Click()
Dim pos As Single
  If ListBox2.Tag = "" Then
      pos = ListBox2.ListIndex * ElemHeight
      If (pos < Frame1.ScrollTop) Or (pos > (Frame1.ScrollTop + Frame1.InsideHeight - ElemHeight)) Then
         Frame1.ScrollTop = pos - ElemHeight
      End If
  End If
End Sub

Private Sub ListBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  ListBox2.Tag = "up" ' bloque le défilement
  ListBox2.ListIndex = Y \ ElemHeight
  ListBox2.Tag = "" ' débloque le défilement
End Sub

 

[francescofrancesco]

Désolé, j'ai déjà utilisé le code du message 8, je vous demande de l'aide supplémentaire.

 

[Rheeem]

Ce n'est pas le même code le dernier concerne les modifications à apporter au code du message #10 spécialement ListBox2_Click et ListBox2_MouseMove

 

[francescofrancesco]

J'ai déjà essayé.
ListBox2.ListIndex = Y \ ElemHeight
Mais le défilement ne dépasse pas les entrées visibles.