remplir une combobox avec un tableau structurer dans un autre classeur

Version imprimable

29/06/2019, 12h15
patricktoulon

remplir une combobox avec un tableau structurer dans un autre classeur

bonjour a tous

je me pose une question
quelle est a la méthode (la plus sur , la moins gourmande , etc...) pour remplir une ComboBox dans mon classeur1 (dans un sheets) avec un tableau structuré qui se trouve dans un fichier".xlsx" fermé

ce tableau est un listingclient (nom,prenom,raison social,adresse,etc......

cet ComboBox servirait a remplir une plage dans un sheets de mon classeur1
des idées?

2 pièce(s) jointe(s)

Bonjour,

On peut par ex utiliser ADO.
BD est le nom de la BD avec les en-têtes.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub UserForm_Initialize()
  'Microsoft ActiveX  Data Object 2.8 doit être activé
  Dim rs As ADODB.Recordset
  Set cnn = New ADODB.Connection
  répertoire = ThisWorkbook.Path
  fichier = "Article.xls"
  cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
    répertoire & "\" & fichier & ";Extended Properties='Excel 12.0;HDR=Yes'"
  Set rs = cnn.Execute("SELECT code,designation,prix FROM BD WHERE code<>''")
  Me.ComboBox1.Column= rs.GetRows
  rs.Close
  cnn.Close
  Set rs = Nothing
  Set cnn = Nothing
  SendKeys "{F4}"
End Sub
 
Private Sub ComboBox1_Change()
  ActiveCell = Me.ComboBox1
  ActiveCell.Offset(, 1) = Me.ComboBox1.Column(1)
  ActiveCell.Offset(, 2) = Me.ComboBox1.Column(2)
  Unload Me
End Sub

Boisgontier

29/06/2019, 12h39
patricktoulon

re

merci jacques je vais tester

une question
le sendkeys"%F4" c'est pourquoi le close ne suffit pas ?

ps: ma ComboBox est comme je l'ai dit dans un sheets et non dans un userform
29/06/2019, 12h53
patricktoulon

re

re
ok bon je suppose que je dois modifier la ligne set rs=.....

et si la plage n'était pas un tableau structuré ?

re
j'ai bien peur de ne pas être dans mon rayon le adodb c'est pas mon truc

mon fichier c'est listingclient.xlsx
le chemin c'est le même que le classeur 1
le tableau s'appelle Tableau2
les entêtes colonnes c'est
Colonne1, n°client, Nom & Prénom, Raison Sociale, Adresse, Adresse Suite, Code & Ville, telephone, mail

je ne pense pas que ca soit ca

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Sub Workbook_Open()
'Microsoft ActiveX  Data Object 2.8 doit être activé
    Dim rs As Object, cnn As Object
    Set cnn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.RecordSet")
    répertoire = ThisWorkbook.Path
    Fichier = "listingclient.xlsx"
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
             répertoire & "\" & Fichier & ";Extended Properties='Excel 12.0;HDR=Yes'"
    Set rs = cnn.Execute("SELECT code,Colonne1,n°client,Nom & Prénom,Raison Sociale,Adresse,Adresse Suite,Code & Ville,telephone,mail FROM Tableau2 WHERE code<>''")
    Sheets(1).ComboBox1.Column = rs.GetRows
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
    SendKeys "{F4}"
End Sub

29/06/2019, 14h10
boisgontierjacques

Il y a au moins une erreur,
Le nom de la BD doit comprendre les titres.
Tableau2 ne comprends pas les titres

Boisgontier

re
j'ai fait comme ton exemple j'ai ajouté un name "BD" dans le fichier listing qui contient le tableau header compris
j'ai mis les items de la même manière que toi dans la macro et j'ai une erreur d'automation sur la ligne set rs=

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub Workbook_Open()
'Microsoft ActiveX  Data Object 2.8 doit être activé
'Colonne1,n°client,Nom & Prénom,Raison Sociale,Adresse,Adresse Suite,Code & Ville,telephone,mail
    Dim rs As Object, cnn As Object
    Set cnn = CreateObject("ADODB.Connection")
    'Set rs = CreateObject("ADODB.RecordSet")
    répertoire = ThisWorkbook.Path
    Fichier = "listingclient.xlsx"
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
             répertoire & "\" & Fichier & ";Extended Properties='Excel 12.0;HDR=Yes'"
    'je met que l'entete"colonne1 pour tester
    Set rs = cnn.Execute("SELECT Colonne1 FROM BD WHERE code<>''")'erreur ici 
    Sheets(1).ComboBox1.Column = rs.GetRows
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
    SendKeys "{F4}"
End Sub

29/06/2019, 14h54
boisgontierjacques

Une autre solution: Copier/Coller avec liaison de la BD dans une feuille du classeur ouvert.

Boisgontier

re
copier/coller???

il faudrait ouvrir le fichier non
pour cela je copie pas je l'ouvre et rempli ma liste
Code:

1 2 3 4 5 6 7 8 9 10 11 Private Sub Workbook_Open() Dim app As Application,wbk As Workbook Set app = CreateObject("excel.application") Set wbk = app.Workbooks.Open(ThisWorkbook.Path & "\listingclient.xlsx") tableau = wbk.Sheets(1).UsedRange.Offset(1).Value'avec l' offset on fait sauter le header ThisWorkbook.Sheets(1).ComboBox1.List = tableau app.Quit End Sub
mais c'est pas top et un peu lourd même si c'est qu'une seconde
c'est pour ca que je cherche autrement

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub test()
With CreateObject("ADODB.Connection")
Sql = " select [n°client],[Nom & Prénom],[Raison Sociale],[Adresse],[Adresse Suite],[Code & Ville],[telephone],[mail] from [Feuil2$]"
    .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties='Excel 12.0;HDR=Yes'"
     Sheets("Feuil1").ComboBox1.Object.Clear
    Sheets("Feuil1").ComboBox1.Object.BoundColumn = 8
        Sheets("Feuil1").ComboBox1.Object.ColumnCount = 8
    Sheets("Feuil1").ComboBox1.Object.List = Application.Transpose(.Execute(Sql).getRows)
    .Close
End With
End Sub

bonjour thumb down et merci
j'ai adapté a mon contexte et j' ai une erreur 13 incompatibilité sur la ligne de remplissage ici en vert
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Sub test() Dim Bd$ Bd = ThisWorkbook.Path & "\listingclient.xlsx" With CreateObject("ADODB.Connection") Sql = " select [n°client],[Nom & Prénom],[Raison Sociale],[Adresse],[Adresse Suite],[Code & Ville],[telephone],[mail] from [Liste client$]" .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Bd & ";Extended Properties='Excel 12.0;HDR=Yes'" Sheets(1).ComboBox1.Object.clear Sheets(1).ComboBox1.Object.BoundColumn = 8 Sheets(1).ComboBox1.Object.ColumnCount = 8 Sheets(1).ComboBox1.Object.List = Application.Transpose(.Execute(Sql).GetRows) .Close End With End Sub
et si je transpose pas

Code:

Sheets(1).ComboBox1.Object.List = (.Execute(Sql).GetRows)

le remplissage est transposé ligne/colonne
:koi:

bon du coup j'ai adapter le sql a celle de jacques et ca match

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Sub Workbook_Open2()
    Sheets(1).ComboBox1.clear
    'Microsoft ActiveX  Data Object 2.8 doit être activé
    'Colonne1,n°client,Nom & Prénom,Raison Sociale,Adresse,Adresse Suite,Code & Ville,telephone,mail
    Dim rs As Object, cnn As Object
    Set cnn = CreateObject("ADODB.Connection")
    'Set rs = CreateObject("ADODB.RecordSet")
    répertoire = ThisWorkbook.Path
    Fichier = "listingclient.xlsx"
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
             répertoire & "\" & Fichier & ";Extended Properties='Excel 12.0;HDR=Yes'"
    'je met que l'entete"colonne1 pour tester
    Set rs = cnn.Execute("select [n°client],[Nom & Prénom],[Raison Sociale],[Adresse],[Adresse Suite],[Code & Ville],[telephone],[mail] from 
[Liste client$]")
    Sheets(1).ComboBox1.Column = rs.GetRows
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
    SendKeys "{F4}"
End Sub

c'est rapide ca fait plaisir
merci a tout les deux
je clos pas le sujet au cas ou vous auriez une amélioration en terme d'écriture de code

29/06/2019, 20h54
Pierre Fauconnier
Salut

Tu peux utiliser les outils d'importation de données de l'onglet Données. Ils permettent d'importer avec liaison les données d'un autre classeur sans aucune ligne de VBA:
- Importation directe;
- MS Query;
- PowerQuery.
Puis tu alimentes ta combo avec les données locales.
29/06/2019, 21h10
patricktoulon

re

bonsoir pierre

oui j'y ai pensé a querytable avec un sheets temporaire mais adodb.connection me permet d'envoyer directement dans la combo

question rapidité c'est nickel
reste a voir si après 2007 les règles n'ont pas changé que je soit pas obligé de tricoter
puissant ce moteur ;)
je n'ai jamais voulu m'y essayer

me reste a comprendre la différence entre le code de base de jacques et de thumb down
pourquoi dans un bloc width le tableau est capté transposé et dans le model de jacques nikel avec le même code du sql

re
ok a etre trop dessus j'ai pas vu la bourde j'utilisais ".list" dans l'un et ".column" dans l'autre
c'était en face moi depuis tout a l'heure :ptdr:

@thmb down :autant utiliser ".column" puisque la transposition de l'object recordset est pas possible

les deux écriture fonctionne

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub test()
    Dim Bd$,tablo
    Bd = ThisWorkbook.Path & "\listingclient.xlsx"
    Sheets(1).ComboBox1.Object.clear
    With CreateObject("ADODB.Connection")
        Sql = "select [n°client],[Nom & Prénom],[Raison Sociale],[Adresse],[Adresse Suite],[Code & Ville],[telephone],[mail] from 
[Liste client$]"
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Bd & ";Extended Properties='Excel 12.0;HDR=Yes'"
        tablo = .Execute(Sql).GetRows
        .Close
        Sheets(1).ComboBox1.Column = tablo
    End With
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub test2()
    Sheets(1).ComboBox1.clear
    Dim rs As Object, cnn As Object
    Set cnn = CreateObject("ADODB.Connection")
    'Set rs = CreateObject("ADODB.RecordSet")'latebinding resultat de Adodb.Connection
    Fichier = "listingclient.xlsx"
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
             ThisWorkbook.Path & "\" & Fichier & ";Extended Properties='Excel 12.0;HDR=Yes'"
    Set rs = cnn.Execute("select [n°client],[Nom & Prénom],[Raison Sociale],[Adresse],[Adresse Suite],[Code & Ville],[telephone],[mail] from 
[Liste client$]")
    Sheets(1).ComboBox1.Column = rs.GetRows
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
    SendKeys "{F4}"
End Sub

donc si je comprend bien cette méthode créé un tableau transposé