Discussion :

[patricktoulon]

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?

[boisgontierjacques]

Bonjour,

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

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
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

[patricktoulon]

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

[patricktoulon]

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

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

[patricktoulon]

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 :

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
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

[boisgontierjacques]

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

Boisgontier

[patricktoulon]

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 :

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
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

[boisgontierjacques]

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


Boisgontier

[patricktoulon]

re
copier/coller???

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Thumb down]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[patricktoulon]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

le remplissage est transposé ligne/colonne

[patricktoulon]

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

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
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

[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.

[patricktoulon]

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

[patricktoulon]

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

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

les deux écriture fonctionne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

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
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é