Bonjour à tous,

Je sèche depuis plusieurs heures sur le transfert d'un tableau à 2 dimensions vers une ListBox.

Mon problème est que je ne retrouve qu'un seul item dans ma ListBox au lieu de quelques centaines stockés dans mon tableau.

J'utilise pour cela :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
With Me.ListBox1
    .List() = filtreTache
    .ListIndex = 0
    .SetFocus
End With
Sachant que filtreTache est une fonction qui renvoit un tableau à 2 dimensions...

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
Function filtreTache()
 
Dim...
 
Set...
 
filtreTache = DoCmdRunSQL("select [" & .Cells(1, 1) & "] from [" & cstrFSMB & "_" & Sheets(csWSFORMS).Cells(3, Sheets(csWSOPTIONS).Cells(1, 2).Value).Value & "$" & .Range(cstrSMBLib).Address(RowAbsolute:=False, columnabsolute:=False) & "] " & filtreTotal & " Group By [" & .Cells(1, 1) & "]", 1)
End With
 
End Function

...puisque DoCmdRunSQL est elle même une fonction renvoyant un tableau à 2 dim :

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
Function DoCmdRunSQL(ByVal sqL As String, nbChamps As Integer) As Variant
Dim db As dao.Database
Dim rs As dao.Recordset
Dim tabRes() As Variant
 
Set db = dao.OpenDatabase(ThisWorkbook.FullName, False, False, "Excel 8.0;HDR=YES;")
Set rs = db.OpenRecordset(sqL, dao.dbOpenSnapshot)
 
If rs.RecordCount <> 0 Then
    ReDim tabRes(1 To rs.Fields.Count, 1 To rs.RecordCount)
    tabRes = rs.GetRows(rs.RecordCount)
    DoCmdRunSQL = tabRes
Else
    ReDim tabRes(1 To 1, 1 To 1)
    tabRes(1, 1) = "Aucune réponse"
    DoCmdRunSQL = tabRes
End If
 
End Function

Quelqu'un comprend-il où est l'erreur ?

Merci d'avance