Combobox et classeur fermé

[Itori]

Bonjour,

J'ai dans un classeur le nom des différents employés dans l'entreprise.
J'utilise un autre classeur pour attribuer à une affaire le personnel affecté dessus.
Afin de pouvoir avoir toujours les même noms, j'ai mis des combobox que je rempli a l'ouverture de mon classeur, avec les noms contenus dans le premier classeur.

Pour réaliser ceci, j'ai fait diverses recherches et j'ai trouver deux fonctions interressantes cependant je n'arrive pas à les adapter comme je voudrai.
J'ai réussi a adapter la première à mon programme, cependant comme elle ne me retourne qu'une seule donnée, elle n'est pas adaptée a ce que je souhaite vu le nombre de requête que cela ferai...
La seconde serait adaptée mais je n'arrive pas a la modifié pour correspondre à ce que je voudrai.

La première adaptée :

Function GetValueWithADO(classeur$, Feuille$, Cell As Range)
'Renvoie la valeur de la cellule Cell de la feuille Feuille du classeur fermé Classeur
Dim RCdSet As Object
Dim strConn As String
Dim strCmd As String
Dim dummyBase As Range

    'Prépare une "base de données" bidon pour la clause SELECT (une entête fictive et une ligne de données)
    Set dummyBase = Cell.Resize(Cell.Rows.Count + 1)
    
    'Prépare les commandes ADO et SQL
    strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
                "Data Source=" & classeur & ";" & _
                "Extended Properties=""Excel 8.0;HDR=No;Imex=1"";"
    strCmd = "SELECT * FROM [" & Feuille & "$" & dummyBase.Address(0, 0) & "]"
    
    'Crée l'objet Recordset
    Set RCdSet = CreateObject("ADODB.Recordset")
    
    'Va cherché l'info
    RCdSet.Open strCmd, strConn, 0, 1, 1 'adOpenForwardOnly, adLockReadOnly, adCmdText
    
    'et la renvoie
    GetValueWithADO = Application.Clean(RCdSet(0))
    
    'nettoyage
    Set RCdSet = Nothing
End Function 'fs

Private Sub Workbook_Open()
Dim i As Integer
Dim fich$, feuill$, Cell As Range
Dim valeur As String
    Application.ScreenUpdating = False
    fich = ThisWorkbook.Path & "\Liste.xls"
    feuill = "feuil1"

    i = 2
    
    While GetValueWithADO(fich, feuill, Cells(i, 2)) <> ""
        ActiveSheet.lst_Typeaffaire.AddItem (GetValueWithADO(fich, feuill, Cells(i, 2)))
        i = i + 1
    Wend
    i = 2
    While GetValueWithADO(fich, feuill, Cells(i, 1)) <> ""
        valeur = GetValueWithADO(fich, feuill, Cells(i, 1))
        ActiveSheet.lst_directeurmiss.AddItem (valeur)
        ActiveSheet.lst_respaff.AddItem (valeur)
        ActiveSheet.lst_perso1.AddItem (valeur)
        ActiveSheet.lst_perso2.AddItem (valeur)
        ActiveSheet.lst_perso3.AddItem (valeur)
        i = i + 1
    Wend
    
    
    i = 2
    While GetValueWithADO(fich, feuill, Cells(i, 3)) <> ""
        ActiveSheet.lst_pdt1.AddItem (GetValueWithADO(fich, feuill, Cells(i, 3)))
        i = i + 1
    Wend
    Application.ScreenUpdating = True
End Sub

La seconde "brut" :

Public Sub GetXLWbkData(FileName As String, RangeName As String)

Dim dbConnection As ADODB.Connection
Dim rs As ADODB.Recordset
Dim dbConnectionString As String

  dbConnectionString = "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;" _
                      & "DBQ=" & FileName
  Set dbConnection = New ADODB.Connection
    
  dbConnection.Open dbConnectionString
    
  Set rs = dbConnection.Execute("[" & RangeName & "]")
  Range("A1") = rs.Fields(0).Name
  Range("A2").CopyFromRecordset rs
  
  rs.Close
  dbConnection.Close
  Set rs = Nothing
  Set dbConnection = Nothing
    
End Sub

Sub test()
  GetXLWbkData "D:\TestADO.xls", "A1:A10"
End Sub

Merci d'avance.

 

[Bebere]

Re : Combobox et classeur fermé

bonjour Itori
un exemple avec combobox,commentaires dans code userform
à bientôt

 

[Itori]

Re : Combobox et classeur fermé

Merci, code très interressant 🙂
En regardant divers message j'ai vu que MichelXD avait un wiki et j'ai trouvé ma solution dessus finalement 🙂

Je rencontre cependant un nouveau problème mais ça sera pour un nouveau topic ^^