[Source][VBA-E] Remplir une zone de liste Excel par une requête Access

voici un code VBA Excel pour remplir une zone de liste à partir d'une requête sur une table Access :

il faut ajouter la référence Microsoft DAO
et avoir un onglet que j'ai appelé "Param" pour recevoir le contenu de la liste.

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
Sub FillCombo()
 
Dim db As DAO.Database
Dim rec As DAO.Recordset
Dim curshname as String, nb as Long
 
curshname = ActiveSheet.Name
Set db = DAO.OpenDatabase("C:\Temp\MaBase.mdb", False, False)
 
Set rec = db.OpenRecordset("SELECT unChamp FROM MaTable WHERE Machin = 'toto'", DAO.dbOpenSnapshot)
 
rec.MoveLast
nb = rec.RecordCount
rec.MoveFirst
ActiveWorkbook.Sheets("Param").Range("A1").CopyFromRecordset rec
 
 
For Each sh In ActiveWorkbook.Sheets(curshname).Shapes
    If sh.Type = msoFormControl And sh.Name Like "Drop*" Then
        sh.Select
            Selection.ListFillRange = "Param!$A$1:$A$" & nb
        Exit For
    End If
Next sh
 
rec.Close
db.Close
 
Set rec = Nothing
Set db = Nothing
 
End Sub

Sub FillCombo() Dim db As DAO.Database Dim rec As DAO.Recordset curshname = ActiveSheet.Name Set db = DAO.OpenDatabase("C:\Temp\MaBase.mdb", False, False) Set rec = db.OpenRecordset("SELECT unChamp FROM MaTable WHERE Machin = 'toto'", DAO.dbOpenSnapshot) For Each sh In ActiveWorkbook.Sheets(curshname).Shapes If sh.Type = msoFormControl And sh.Name Like "Drop*" Then sh.Select Do While Not (rec.EOF) Selection.AddItem rec.Fields(0).Value rec.MoveNext Loop Exit For End If Next sh rec.Close db.Close Set rec = Nothing Set db = Nothing End Sub