Problème alimentation ListBox

Adriano43

XLDnaute Occasionnel
bonjour à toutes et à tous,

Je rencontre actuellement un problème pour alimenter ma listbox. Initialement, le code suivant (avec l'aide du forum), était destiné à donner les infos via une msgbox. Néanmoins et ayant bien avancé sur mon classeur, j'ai mis en place plusieurs Usf qui fonctionne tous à l'éxecption d'une listbox nommée Listbox1 qui doit retourner les valeurs contenues dans la msgbox, sauriez vous comment adapter le code? J'ai fais plusieurs tentatives mais sans réussite...
Code:
Private Sub CommandButton6_Click()
    
    Dim i&, D As Object, t As Variant, msg$
    Dim tableau As Variant
    Set D = CreateObject("Scripting.Dictionary")
    'T(i) = Valeur en colonne Q
    'D(T(i)) = Lettre en colonne R
    msg = "Fréquence" & vbTab & vbTab & "A" & vbLf
    
    With Sheets("BDD")
       For i = 2 To .Cells(Rows.Count, 17).End(xlUp).Row
          If Not IsError(.Cells(i, 17).Value) Then 'si la cellule n'est pas en erreur
          If .Cells(i, 2).Interior.ColorIndex = 3 Then 'si la couleur de la cellule est rouge (3)
          If .Cells(i, 17).Value > 0 Then 'si la valeur de la cellule est suppérieur à 0
             D(.Cells(i, 17).Value) = .Cells(i, 18).Value
          End If
          End If
          End If
       Next i
    End With
    t = D.Keys
    Call prctri(t, LBound(t), UBound(t))
    ReDim Preserve t(1 To 250)
    For i = 1 To 250
        ListBox1.List = Format(t(i), "00.00") & vbTab & vbTab & vbTab & D(t(i)) & vbLf
    Next i
End Sub

Cordialement

Adriano43
 

Adriano43

XLDnaute Occasionnel
Re : Problème alimentation ListBox

Re,

Merci de votre aide mais cela ne marche toujours pas....
Voici le code original qui alimente une msgbox, comment l'adapter pour que le résultat apparaisse dans une Listbox1 vu que j'ai désormais fait un Usf...
Code:
Public Sub prcheure()

    Dim i&, D As Object, t As Variant, msg$
    Set D = CreateObject("Scripting.Dictionary")
    'T(i) = Valeur en colonne B
    'D(T(i)) = Lettre en colonne A
    msg = "Horaire" & vbTab & vbTab & "A" & vbLf
    
    With Sheets("Programmation")
       For i = 101 To .Cells(Rows.Count, 2).End(xlUp).Row
          If Not IsError(.Cells(i, 2).Value) Then 'si la cellule n'est pas en erreur
          If .Cells(i, 2).Value > 0 Then 'si la valeur de la cellule est suppérieur à 0
             D(.Cells(i, 2).Value) = .Cells(i, 1).Value
          End If
          End If
       Next i
    End With
    
    t = D.Keys
    ReDim Preserve t(1 To 100)
    For i = 1 To 100
        msg = msg & vbTab & Format(t(i), "hh:mm") & vbTab & vbTab & D(t(i)) & vbLf
    Next i
    MsgBox msg, 64, "Organisation"
    
End Sub
 

Discussions similaires

Réponses
4
Affichages
165