ADO - demande aide sur 1 procedure de Frederic Sigonneau

Bonjour

Voici mon probleme :

J ai un classeur excel fermé contenant deux colones :

1) Champ liste --> c est une colone contenant une liste, en texte, de mat ériel
2) Champ Prix --> c est une colone contenant le prix correspondant au mat ériel

Un deuxieme classeur doit pouvoir, en entrant le nom du materiel , me
renvoyer le prix.

J ai utilisé une procedure de F S. -->http://frederic.sigonneau.free.fr/

Merci a lui en attendant.

***********************************************
Attribute VB_Name = "ADOGetValue"

'lire la valeur d'une cellule dans un classeur fermé

Sub test()
Dim fich$, feuil$, Cell As Range
  fich = "D:TestADO.xls"
  feuil = "feuil1" 'ici, il y a mes deux colones liste et prix

  cherchval = "ces 10"  

'j ai modifie ca :

  I = 1  
    do
       Set Cell = Range("A" & I)

        resu =  GetValueWithADO(fich, feuil, Cell)
       I =I+1
   loop until I = 1000 or resu = Test

   msgbox  GetValueWithADO(fich, feuil, Cell)

End Sub

'Note : cette fonction est utilisable dans une feuille de calcul
'Ex :
' =GetValueWithADO("D:TestADO.xls";"feuil1";A1)

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=N o;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, adLockReadOnl y,
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

Et en fait, la boucle est trop lente
J arrive pas a trouver un truc pour faire ce test directement avbec ado av ec
un find ou je sais pas quoi

Merci e m aider si y en a qui connaissent un peu ADO

Merci Merci

Bonjour,

Temps de réponse:0,06s:

Nom     Prenom  Salaire         Nom de champ
Durand  Jean    6000            MaBD    =Feuil1!$A $1:$C$500
Martin  Daniel  7000
Toto    Michel  8000
Koko    Nicole  5500

Sub essai()
  'Microsoft ActiveX DataObject doit être coché
  ' Champ nommé MaBD avec lignes vides
  Set cnn = New ADODB.Connection
  t = Timer()
  nomcherche = "Besnard"
  repertoire = ThisWorkbook.Path & ""
  cnn.Open "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ =" &
_
      repertoire & "ADOsource.xls"
      Sql = "SELECT Prenom,salaire FROM MaBD WHERE nom='" & nomc herche
& "'"
  Set rs = cnn.Execute(Sql)
  '[B1] = rs.GetRows
  [B1] = rs("prenom")
  [C1] = rs("salaire")
  rs.Close
  cnn.Close
  Set rs = Nothing
  Set cnn = Nothing
  MsgBox Timer() - t
End Sub

JBhttp://boisgontierjacques.free.fr/

On 22 avr, 22:58, ced <c...@discussions.microsoft.com> wrote:

Bonjour

Voici mon probleme :

J ai un classeur excel fermé contenant deux colones :

1) Champ liste --> c est une colone contenant une liste, en texte, de ma tériel
2) Champ Prix --> c est une colone contenant le prix correspondant au ma tériel

Un deuxieme classeur doit pouvoir, en entrant le nom du materiel , me
renvoyer le prix.

J ai utilisé une procedure de F S. -->http://frederic.sigonneau.free.f r/

Merci a lui en attendant.

***********************************************
Attribute VB_Name = "ADOGetValue"

'lire la valeur d'une cellule dans un classeur fermé

Sub test()
Dim fich$, feuil$, Cell As Range
  fich = "D:TestADO.xls"
  feuil = "feuil1" 'ici, il y a mes deux colones liste et prix

  cherchval = "ces 10"  

'j ai modifie ca :

  I = 1  
    do
       Set Cell = Range("A" & I)

        resu =  GetValueWithADO(fich, feuil, Cell)
       I =I+1
   loop until I = 1000 or resu = Test

   msgbox  GetValueWithADO(fich, feuil, Cell)

End Sub

'Note : cette fonction est utilisable dans une feuille de calcul
'Ex :
' =GetValueWithADO("D:TestADO.xls";"feuil1";A1)

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, adLockReadO nly,
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

Et en fait, la boucle est trop lente
J arrive pas a trouver un truc pour faire ce test directement avbec ado avec
un find ou je sais pas quoi

Merci e m aider si y en a qui connaissent un peu ADO

Merci Merci- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -

Autre méthode:

0,015 s

Sub essai2()
t = Timer()
repertoire = ThisWorkbook.Path & "/"
nomcherche = "Besnard"
formule = "=vlookup(" & Chr(34) & nomcherche & Chr(34) & ",'" &
repertoire & "ADOsource.XLS'!MaBD,2,false)"
[B1].Formula = formule
x = [B1]
MsgBox Timer() - t
End Sub

JB

On 23 avr, 07:06, JB <boisgont...@hotmail.com> wrote:

Bonjour,

Temps de réponse:0,06s:

Nom Prenom Salaire Nom de champ
Durand Jean 6000 MaBD þuil1!$A$1:$C$500
Martin Daniel 7000
Toto Michel 8000
Koko Nicole 5500

Sub essai()
'Microsoft ActiveX DataObject doit être coché
' Champ nommé MaBD avec lignes vides
Set cnn = New ADODB.Connection
t = Timer()
nomcherche = "Besnard"
repertoire = ThisWorkbook.Path & ""
cnn.Open "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=" &
_
repertoire & "ADOsource.xls"
Sql = "SELECT Prenom,salaire FROM MaBD WHERE nom='" & nomcherche
& "'"
Set rs = cnn.Execute(Sql)
'[B1] = rs.GetRows
[B1] = rs("prenom")
[C1] = rs("salaire")
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
MsgBox Timer() - t
End Sub

JBhttp://boisgontierjacques.free.fr/

On 22 avr, 22:58, ced <c...@discussions.microsoft.com> wrote:

Bonjour

Voici mon probleme :

J ai un classeur excel fermé contenant deux colones :

1) Champ liste --> c est une colone contenant une liste, en texte, de matériel
2) Champ Prix --> c est une colone contenant le prix correspondant au matériel

Un deuxieme classeur doit pouvoir, en entrant le nom du materiel , me
renvoyer le prix.

J ai utilisé une procedure de F S. -->http://frederic.sigonneau.free.fr/

Merci a lui en attendant.

***********************************************
Attribute VB_Name = "ADOGetValue"

'lire la valeur d'une cellule dans un classeur fermé

Sub test()
Dim fich$, feuil$, Cell As Range
fich = "D:TestADO.xls"
feuil = "feuil1" 'ici, il y a mes deux colones liste et prix

cherchval = "ces 10"

'j ai modifie ca :

I = 1
do
Set Cell = Range("A" & I)

resu = GetValueWithADO(fich, feuil, Cell)
I =I+1
loop until I = 1000 or resu = Test

msgbox GetValueWithADO(fich, feuil, Cell)

End Sub

'Note : cette fonction est utilisable dans une feuille de calcul
'Ex :
' =GetValueWithADO("D:TestADO.xls";"feuil1";A1)

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

Et en fait, la boucle est trop lente
J arrive pas a trouver un truc pour faire ce test directement avbec ado avec
un find ou je sais pas quoi

Merci e m aider si y en a qui connaissent un peu ADO

Merci Merci- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -

Bonjour JB.

Merci de tes reponses.
Bon, avant d explorer la deuxieme solution, je voudrais bien resoudre la
premiere.

J ai bien MaBD --> 'MaBD =Feuil1!$A$1:$C$993
J ai deux champs --> liste et prix

Et ca bug a la ligne : Set rs = cnn.Execute(Sql)
"[Microsoft] [Pilote ODBC Excel] trop peu de parametre. 3 attendu"
Pourtant, j ai bien coche : Microsoft ActiveX object 2.5 library

J ai laisse la ligne A vide ( je sais pas trop pourquoi)

Et j ai modifie ton code en fonction de mon truc

Merci de ta reponse

Sub essai()
'MaBD =Feuil1!$A$1:$C$993
Dim rs
'Microsoft ActiveX DataObject doit être coché
' Champ nommé MaBD avec lignes vides
Set cnn = New ADODB.Connection
'Set cnn = CreateObject("ADODB.Connection")

t = Timer()
nomcherche = "ces 300"

repertoire = "C:Documents and SettingscfradicMy DocumentsLog
CedProgrammes ProjetGrille sans liaisonslire fichier ferméa_fichiers
excelabo dont 1 ado"

cnn.Open "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=" & _
repertoire & "classeur1.xls"
Sql = "SELECT liste,prix FROM MaBD WHERE nom='" & nomcherche & "'"
Set rs = cnn.Execute(Sql)
'[B1] = rs.GetRows
[A1] = rs("liste")
[B1] = rs("prix")

rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
MsgBox Timer() - t
End Sub

Autre méthode:

0,015 s

Sub essai2()
  t = Timer()
  repertoire = ThisWorkbook.Path & "/"
  nomcherche = "Besnard"
  formule = "=vlookup(" & Chr(34) & nomcherche & Chr(34) & ",'" &
repertoire & "ADOsource.XLS'!MaBD,2,false)"
  [B1].Formula = formule
  x = [B1]
  MsgBox Timer() - t
End Sub

JB

On 23 avr, 07:06, JB <boisgont...@hotmail.com> wrote:

Bonjour,

Temps de réponse:0,06s:

Nom     Prenom  Salaire         Nom de champ
Durand  Jean    6000            MaBD    =Feuil 1!$A$1:$C$500
Martin  Daniel  7000
Toto    Michel  8000
Koko    Nicole  5500

Sub essai()
  'Microsoft ActiveX DataObject doit être coché
  ' Champ nommé MaBD avec lignes vides
  Set cnn = New ADODB.Connection
  t = Timer()
  nomcherche = "Besnard"
  repertoire = ThisWorkbook.Path & ""
  cnn.Open "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;D BQ=" &
_
      repertoire & "ADOsource.xls"
      Sql = "SELECT Prenom,salaire FROM MaBD WHERE nom='" & nomcherche
& "'"
  Set rs = cnn.Execute(Sql)
  '[B1] = rs.GetRows
  [B1] = rs("prenom")
  [C1] = rs("salaire")
  rs.Close
  cnn.Close
  Set rs = Nothing
  Set cnn = Nothing
  MsgBox Timer() - t
End Sub

JBhttp://boisgontierjacques.free.fr/

On 22 avr, 22:58, ced <c...@discussions.microsoft.com> wrote:

Bonjour

Voici mon probleme :

J ai un classeur excel fermé contenant deux colones :

1) Champ liste --> c est une colone contenant une liste, en texte, d e matériel
2) Champ Prix --> c est une colone contenant le prix correspondant a u matériel

Un deuxieme classeur doit pouvoir, en entrant le nom du materiel , m e
renvoyer le prix.

J ai utilisé une procedure de F S. -->http://frederic.sigonneau.fr ee.fr/

Merci a lui en attendant.

***********************************************
Attribute VB_Name = "ADOGetValue"

'lire la valeur d'une cellule dans un classeur fermé

Sub test()
Dim fich$, feuil$, Cell As Range
  fich = "D:TestADO.xls"
  feuil = "feuil1" 'ici, il y a mes deux colones liste et prix

  cherchval = "ces 10"  

'j ai modifie ca :

  I = 1  
    do
       Set Cell = Range("A" & I)

        resu =  GetValueWithADO(fich, feuil, Cell)
       I =I+1
   loop until I = 1000 or resu = Test

   msgbox  GetValueWithADO(fich, feuil, Cell)

End Sub

'Note : cette fonction est utilisable dans une feuille de calcul
'Ex :
' =GetValueWithADO("D:TestADO.xls";"feuil1";A1)

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;H DR=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, adLockR eadOnly,
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

Et en fait, la boucle est trop lente
J arrive pas a trouver un truc pour faire ce test directement avbec ado avec
un find ou je sais pas quoi

Merci e m aider si y en a qui connaissent un peu ADO

Merci Merci- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -- Masquer le texte de s messages précédents -

- Afficher le texte des messages précédents -

Bonjour

Voici mon probleme :

J ai un classeur excel fermé contenant deux colones :

1) Champ liste --> c est une colone contenant une liste, en texte, de matériel
2) Champ Prix --> c est une colone contenant le prix correspondant au matériel

Un deuxieme classeur doit pouvoir, en entrant le nom du materiel , me
renvoyer le prix.

J ai utilisé une procedure de F S. --> http://frederic.sigonneau.free.fr/

Merci a lui en attendant.

***********************************************
Attribute VB_Name = "ADOGetValue"

'lire la valeur d'une cellule dans un classeur fermé

Sub test()
Dim fich$, feuil$, Cell As Range
fich = "D:TestADO.xls"
feuil = "feuil1" 'ici, il y a mes deux colones liste et prix

cherchval = "ces 10"

'j ai modifie ca :

I = 1
do
Set Cell = Range("A" & I)

resu = GetValueWithADO(fich, feuil, Cell)
I =I+1
loop until I = 1000 or resu = Test

msgbox GetValueWithADO(fich, feuil, Cell)


End Sub

'Note : cette fonction est utilisable dans une feuille de calcul
'Ex :
' =GetValueWithADO("D:TestADO.xls";"feuil1";A1)

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



Et en fait, la boucle est trop lente
J arrive pas a trouver un truc pour faire ce test directement avbec ado avec
un find ou je sais pas quoi

Merci e m aider si y en a qui connaissent un peu ADO

Merci Merci

Merci JB
Mais ca ne marche toujours pas

J ai rechange le code un peu
J ai recree une MaBD dans un nouveau classeur1.xls comme toi
avec 3 colones liste / prix / MO  mis dans la premiere ligne

j ai change ca aussi
'Set cnn = New ADODB.Connection
Set cnn = CreateObject("ADODB.Connection")

Sub essai()
'MaBD =Feuil1!$A$1:$C$993
Dim rs
'Microsoft ActiveX DataObject doit être coché
' Champ nommé MaBD avec lignes vides
'Set cnn = New ADODB.Connection
Set cnn = CreateObject("ADODB.Connection")

t = Timer()
nomcherche = "ces 20"

'repertoire = "C:Documents and SettingscfradicMy DocumentsLog
CedProgrammes ProjetGrille sans liaisonslire fichier ferméa_fichiers
excelabo dont 1 ado"
repertoire = ThisWorkbook.Path & ""

cnn.Open "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=" & _
repertoire & "classeur1.xls"
'Sql = "SELECT liste,prix FROM MaBD WHERE nom ='" & nomcherche & "'"
Sql = "SELECT prix,MO FROM MaBD WHERE nom ='" & nomcherche & "'"

Set rs = cnn.Execute(Sql)
'[B1] = rs.GetRows
'[B1] = rs("prenom")
'[C1] = rs("salaire")
[A1] = rs("liste")
[B1] = rs("prix")

rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
MsgBox Timer() - t
End Sub

Ca marche toujours pas. Même erreur

Faux il que je t envoie mes deux fichiers xls?

Bonjour

Voici mon probleme :

J ai un classeur excel fermé contenant deux colones :

1) Champ liste --> c est une colone contenant une liste, en texte, de ma tériel
2) Champ Prix --> c est une colone contenant le prix correspondant au ma tériel

Un deuxieme classeur doit pouvoir, en entrant le nom du materiel , me
renvoyer le prix.

J ai utilisé une procedure de F S. -->http://frederic.sigonneau.free.f r/

Merci a lui en attendant.

***********************************************
Attribute VB_Name = "ADOGetValue"

'lire la valeur d'une cellule dans un classeur fermé

Sub test()
Dim fich$, feuil$, Cell As Range
  fich = "D:TestADO.xls"
  feuil = "feuil1" 'ici, il y a mes deux colones liste et prix

  cherchval = "ces 10"  

'j ai modifie ca :

  I = 1  
    do
       Set Cell = Range("A" & I)

        resu =  GetValueWithADO(fich, feuil, Cell)
       I =I+1
   loop until I = 1000 or resu = Test

   msgbox  GetValueWithADO(fich, feuil, Cell)

End Sub

'Note : cette fonction est utilisable dans une feuille de calcul
'Ex :
' =GetValueWithADO("D:TestADO.xls";"feuil1";A1)

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, adLockReadO nly,
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

Et en fait, la boucle est trop lente
J arrive pas a trouver un truc pour faire ce test directement avbec ado avec
un find ou je sais pas quoi

Merci e m aider si y en a qui connaissent un peu ADO

Merci Merci- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -

Les 2 fichiers doivent être dans lem^me répertoire:

http://cjoint.com/?exl6KD6Xxt

JB


On 23 avr, 11:36, ced <c...@discussions.microsoft.com> wrote:

Merci JB
Mais ca ne marche toujours pas

J ai rechange le code un peu
J ai recree une MaBD dans un nouveau classeur1.xls comme toi
avec 3 colones liste / prix / MO mis dans la premiere ligne

j ai change ca aussi
'Set cnn = New ADODB.Connection
Set cnn = CreateObject("ADODB.Connection")

Sub essai()
'MaBD þuil1!$A$1:$C$993
Dim rs
'Microsoft ActiveX DataObject doit être coché
' Champ nommé MaBD avec lignes vides
'Set cnn = New ADODB.Connection
Set cnn = CreateObject("ADODB.Connection")

t = Timer()
nomcherche = "ces 20"

'repertoire = "C:Documents and SettingscfradicMy DocumentsLog
CedProgrammes ProjetGrille sans liaisonslire fichier ferméa_fichiers
excelabo dont 1 ado"
repertoire = ThisWorkbook.Path & ""

cnn.Open "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=" & _
repertoire & "classeur1.xls"
'Sql = "SELECT liste,prix FROM MaBD WHERE nom ='" & nomcherche & "'"
Sql = "SELECT prix,MO FROM MaBD WHERE nom ='" & nomcherche & "'"

Set rs = cnn.Execute(Sql)
'[B1] = rs.GetRows
'[B1] = rs("prenom")
'[C1] = rs("salaire")
[A1] = rs("liste")
[B1] = rs("prix")

rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
MsgBox Timer() - t
End Sub

Ca marche toujours pas. Même erreur

Faux il que je t envoie mes deux fichiers xls?

Bonjour

Voici mon probleme :

J ai un classeur excel fermé contenant deux colones :

1) Champ liste --> c est une colone contenant une liste, en texte, de matériel
2) Champ Prix --> c est une colone contenant le prix correspondant au matériel

Un deuxieme classeur doit pouvoir, en entrant le nom du materiel , me
renvoyer le prix.

J ai utilisé une procedure de F S. -->http://frederic.sigonneau.free.fr/

Merci a lui en attendant.

***********************************************
Attribute VB_Name = "ADOGetValue"

'lire la valeur d'une cellule dans un classeur fermé

Sub test()
Dim fich$, feuil$, Cell As Range
fich = "D:TestADO.xls"
feuil = "feuil1" 'ici, il y a mes deux colones liste et prix

cherchval = "ces 10"

'j ai modifie ca :

I = 1
do
Set Cell = Range("A" & I)

resu = GetValueWithADO(fich, feuil, Cell)
I =I+1
loop until I = 1000 or resu = Test

msgbox GetValueWithADO(fich, feuil, Cell)

End Sub

'Note : cette fonction est utilisable dans une feuille de calcul
'Ex :
' =GetValueWithADO("D:TestADO.xls";"feuil1";A1)

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

Et en fait, la boucle est trop lente
J arrive pas a trouver un truc pour faire ce test directement avbec ado avec
un find ou je sais pas quoi

Merci e m aider si y en a qui connaissent un peu ADO

Merci Merci- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -