ADO - demande aide sur 1 procedure de Frederic Sigonneau

Le
ced
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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
JB
Le #6313251
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



JB
http://boisgontierjacques.free.fr/

On 22 avr, 22:58, ced
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


JB
Le #6324171
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
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='" & 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


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 -



ced
Le #6327521
Bonjour JB.

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

J ai bien MaBD --> 'MaBD þuil1!$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 þ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 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
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


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 -







JB
Le #6327491
La ligne A doit contenir les titres de la BD.

http://cjoint.com/?exkkFi0FGy

JB
On 23 avr, 09:30, ced
Bonjour JB.

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

J ai bien MaBD --> 'MaBD þuil1!$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 þ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 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
Bonjour,

Temps de réponse:0,06s:

Nom     Prenom  Salaire         Nom de champ
Durand  Jean    6000            MaBD    þuil 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
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 -





ced
Le #6334281
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




JB
Le #6334271
Les 2 fichiers doivent être dans lem^me répertoire:

http://cjoint.com/?exl6KD6Xxt

JB


On 23 avr, 11:36, ced
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 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 -



ced
Le #6347991
Ca y est, ca marche enfin ...

C ca qui collais pas :
Sql = "SELECT prix,MO FROM MaBD WHERE nom ='" & nomcherche & "'"
changé par :
Sql = "SELECT prix,MO FROM MaBD WHERE liste ='" & nomcherche & "'"

Et oui, j avais pas compris le code.
Le nom, C'etait le champ de ta recherche. Je l ai vu qu en tatonnant sur ton
code.

Ouf

Merci pour tout



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

http://cjoint.com/?exl6KD6Xxt

JB


On 23 avr, 11:36, ced
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 -







Publicité
Poster une réponse
Anonyme