johnmjs a écrit :
Salut, je cherche actuellement à faire quelque chose de similaire (pas tout fait mais c'est dans le même genre), j'ai trouvé ce lien : http://frederic.sigonneau.free.fr/Ado.htm j'ai pas eu le temps de regarder mais ça pourra peut etre t'aider, tiens moi au courant du résultat
|
Merci pour le lien, il y a pas mal de chose intéressante dedans. Ca m’a permis de trouver une solution. Je ne pense pas que ce soit la plus simple et la moins gourmande en temps d’exécution mais au moins ça marche.
Pour illustrer je vais reprendre l’exemple précédent. Voila le code que j’utilise maintenant :
Sub exempletest()
With ThisWorkbook
Dim fich$, feuil$, Cell As Range
fich = "D\fichier.xls"
feuil = "table"
‘Mettre l’emplacement du fichier et le nom de l’onglet dans lequel sont les données
Dim i As Integer
Dim n As Integer
Dim k As Integer
Dim bool As Double
Dim etat As String
Dim valeur As String
Dim ok As String
n = 7
k = 2
ok = "ok"
For i = 1 To n
Set Cell = Range("A" & i)
etat = GetValueWithADO(fich, feuil, Cell)
bool = StrComp(etat, ok, vbTextCompare)
If bool = 0 Then
Set Cell = Range("B" & i)
valeur = GetValueWithADO(fich, feuil, Cell)
ThisWorkbook.Worksheets("travail" ).Cells(2 + k, 1) = valeur
k = k + 1
End If
Next
End With
End Sub
' Fonction pour récupérer les données sur un autre fichier
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(2)
'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 chercher l'info
RcdSet.Open strCmd, strConn, 0, 1, 1 'adOpenForwardOnly, adLockReadOnly, adCmdText
'et la renvoie
GetValueWithADO = Application.Clean(RcdSet(0))
'autre syntaxe possible
' GetValueWithADO =Application.Clean(RcdSet.GetString(NumRows:=1))
'nettoyage
Set RcdSet = Nothing
End Function 'fs
Voila, si tu as des questions, n’hésite pas et merci encore.