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 :
La seconde "brut" :
Merci d'avance.
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 :
Code:
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
Code:
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" :
Code:
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.