Ajouter valeurs dans Combobox provenant d'un fichier fermé

Bonjour,

Je cherche depuis plusieurs jours comment récupérer dans une combobox des valeurs provenant d'un fichierbfermé

Voici le code que j'utilise pour récupérer les données

Private Sub Initialize()

hidden.Visible = xlSheetVisible

Dim Source As ADODB.Connection
Dim Rst As ADODB.Recordset, Rsc As ADODB.Recordset

Dim Fichier As String, Cellule As String, Feuille As String
Dim j As Integer

Fichier = "Z:\BASE DE DONNEES\Test macro pour FT\BD1.xlsx"
Feuille = "Feuil1$"

Set Source = New ADODB.Connection
With Source
.Provider = "Microsoft.JET.OLEDB.4.0"
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
.Open
End With

For j = 1 To Range("A65536").End(xlUp).Row

Cellule = "A" & j & ":A" & j

Set ADOCommand = New ADODB.Command
With ADOCommand
.ActiveConnection = Source
.CommandText = "SELECT*FROM[" & Feuille & Cellule & "]"
End With

Set Rst = New ADODB.Recordset
Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic

Set Rst = Source.Execute("[" & Feuille & Cellule & "]")

Range("A" & j).CopyFromRecordset Rst

Next j

Rst.Close
Set Rst = Nothing
Source.Close
Set Source = Nothing

End Sub

Pour afficher mes valeurs sans doublons dans la combobox j'utilise :

Dim j As Integer

For j = 1 To Range("A65536").End(xlUp).Row
ComboBox1 = Range("A" & j)
If ComboBox1.ListIndex = -1 Then ComboBox1.AddItem Range("A" & j) 'Truc magique de papa qui bloque les doublons
Next j

Si quelqu'un à une solution ou à déjà réalisé ce genre de chose j'en suis curieux

Merci d'avance de vos aides

LL

Bonjour,

Tu peux largement optimiser ton code. En effet, il est inutile de copier les données dans ton fichier pour alimenter ta combo.

Dans un module à part tu te crées les 2 fonctions génériques 'Query' et 'Get_Combo' :

Option Explicit

Public Const NDF = "Z:\BASE DE DONNEES\Test macro pour FT\BD1.xlsx"

Private RcdSt() As Variant
Private Req As String

' *************************************************************************************************
Function Query(Req As String) As Long
Dim Cnx As Object, Rst As Object
Dim i As Long, j As Long

    On Error GoTo errhdlr

    Set Cnx = CreateObject("ADODB.Connection")
    Cnx.Provider = "MSDASQL"

    Cnx.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
             "DBQ=" & NDF & "; ReadOnly=False;"

    If Left(Req, 6) = "SELECT" Then
        Set Rst = CreateObject("ADODB.Recordset")
        Rst.Open Req, Cnx, 3 

        Query = Rst.RecordCount
        If Not Query = 0 Then
            ReDim RcdSt(Rst.Fields.Count - 1, Query - 1)
            Rst.MoveFirst
            RcdSt = Rst.GetRows
            For i = 0 To UBound(RcdSt, 1) - 1
                For j = 0 To UBound(RcdSt, 2) - 1
                    If IsNull(RcdSt(i, j)) Then RcdSt(i, j) = ""
                Next j
            Next i
        End If
    Else
        Cnx.Execute Req
        Query = 0
    End If

    Cnx.Close
    Set Rst = Nothing
    Set Cnx = Nothing
    Exit Function

errhdlr:
    If Not Rst Is Nothing Then If Rst.State = 1 Then Rst.Close
    If Not Cnx Is Nothing Then If Cnx.State = 1 Then Cnx.Close
    Set Rst = Nothing
    Set Cnx = Nothing
    Query = -1
    MsgBox (Err.Description)
End Function

' *************************************************************************************************
Function Get_Combo(Chps As String, Ong As String) As Variant()
    Req = "SELECT DISTINCT " & Chps & " FROM [" & Ong & "$] ORDER BY " & Chps
    Erase Get_Combo
    If Query(Req) > 0 Then Get_Combo = Application.Transpose(RcdSt)
End Function

Déjà en utilisant dans ta requête le DISTINCT, tu élimines les doublons et en utilisant le ORDER tu fais un tri croissant. Pour un tri décroissant il suffit d'ajouter : ... ORDER BY " & Chps & " DESC"

(tant qu'à faire autant profiter de la puissance du Sql!)

Nb : en passant la fonction 'Query' est réutilisable pour n'importe quelle requête Sql

Ensuite c'est simple, pour récupérer la liste, par exemple, de la colonne "Ville" de tes data, il suffit de dire :

Combobox1.list=Get_Combo("Ville","Feuil1")

C'est tout! (ici l'onglet 'Feuil1' est l'onglet de ton fichier fermé duquel tu extrait les data)

Tu aura remarqué que je n'utilise pas la connexion JET, mais le OLE DB ODBC : ça améliore la portabilité de ton appli puisque non dépendante de la version d'excel installée sur le PC! Et pour la même raison, j'utilise ici les liaisons tardives pour ne pas dépendre de la version des références MS ADO ou autres

Pierre

Merci pour ta réponse ton code fonctionne super !

Par contre j'ai une deuxième combobox à remplir en fonction de la première sur mon ancienne version j'utilisée ça :

Dim Cell As Range
For Each Cell In Range("A1:A65536") 'Boucle pour chaque cellule
If Cell = "" & ComboBox1.Value Then 'Verifie la valeur du menu déroulant 1
ComboBox2.AddItem Cell(1, 2) 'Ajoute seulement les valeurs de la colonne 2 selon la valeur du menu deroulant 1
End If
Next Cell

Et voici un aperçu de la base de donnees en document joint

Ensuite le but et de récupérer chaque paramètre pour les coller à un endroit specifique

Mais avec ça je suis complètement perdu :/

Merci de ton aide

LL

OK, c'est pas dur.

Tu enrichis la fonction Get_combo comme ceci :

Function Get_Combo(Chps As String, Ong As String, Optional Cnd As String) As Variant()

    Req = "SELECT DISTINCT " & Chps & " FROM [" & Ong & "$]"

    If Not Cnd = "" Then Req = Req & " WHERE " & Cnd

    Req = Req & " ORDER BY " & Chps

    Erase Get_Combo
    If Query(Req) > 0 Then Get_Combo = Application.Transpose(RcdSt)

End Function

De cette façon, il suffit simplement de remplir le combo2 en fonction de la valeur du combo1 (ici dans l'exemple, le combo2 listera le noms des rues en fonction de la ville choisie dans le combo1), dans ton code de l'userform tu écrira :

Private Sub UserForm_Activate()
    Combobox1.list=Get_Combo("Ville","Feuil1")
End Sub

Private Sub ComboBox1_Change()
    ComboBox2.List = Get_Combo("Rue","Feuil1", "Ville='" & ComboBox1.Value & "'")
End Sub

C'est tout!

Pierre