transfert

Si l'objectif est d'importer des données d'une feuille d'un classeur fermé
dans le classeur ouvert, voici un exemple général de code :

Tu dois ajouter la bibliothèque
"Microsoft Activex Data Objects 2.x Libaray"

Et tu adaptes, chemin , nom de fichier , nom de la feuille...

'----------------------------------------
Sub ImporterDesDonnéesDeAccess()

Dim X As Integer, C As Integer
Dim Cnt As New ADODB.Connection
Dim Rst As New ADODB.Recordset
Dim Rg As Range, Sh As Worksheet
Dim NbEnr As Long, CheminDb As String
Dim NNomFeuille As String
Dim Tblo As Variant, Requete As String

CheminDb = "C:Classeur1.xls"
NomFeuille = "Feuil1"
Requete = "Select * From [" & NomFeuille & "$]"

'La chaîne de connexion à une base de donnée Access
Cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & CheminDb & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'Ouverture du recordset
Rst.Open Requete, Cnt, adOpenStatic

'Si aucun enregistrement est trouvé lors de la requête
If Rst.RecordCount = 0 Then
MsgBox "Aucun enregistrement trouvé." & vbCrLf & _
"Fin de l'opération.", vbInformation + vbOKOnly, "Annulation"
' Ferme la connection et le recordset
Rst.Close: Cnt.Close
'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
Exit Sub
End If

'Éviter le rafraîchissement de l'écran
Application.ScreenUpdating = False

'Conserve dans une variable le nom de la feuille active.
NomFeuille = ThisWorkbook.ActiveSheet.Name

'Ajoute une nouvelle feuille où seront acheminées les données
Set Sh = Worksheets.Add

'détermine la cellule supérieur gauche où
'le recordset va être copié
With Sh
Set Rg = .Range("A1")
End With

'Si tu es intéressé de récupérer directement les noms
'des champs de ton recordset, tu peux utiliser ce
'qui suit :

Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
X = X + 1
Loop Until X = Rst.Fields.Count

'Section copiant le recordset dans excel

'La procédur va pouvoir choisir selon la version
'd'excel d'installer laquelle des méthodes choisir.

'Un test sur la version excel en cours ...
If Val(Mid(Application.Version, 1, InStr(1, _
Application.Version, ".") - 1)) > 8 Then
'EXCEL 2000 or 2002: La méthode CopyFromRecordset
Rg.Offset(1).CopyFromRecordset Rst
Else
'EXCEL 97 ou antérieur: Méthode GetRows

' GetRows transforme le recordset en tableau de base 0
Tblo = Rst.GetRows
'Première dimension tableau = Champ du recordset
'Deuxièm dimension Tableau = Données du recordset

'Détermine le nombre d'enregistrements
'Le +1 c'est pour tenir compte du tableau qui est de
'base 0 ... première cellule dans excel est cells(1,1)
NbEnr = UBound(Tblo, 2) + 1

'Transpose le tableau(tblo) pour que la première dimension
'devienne les données et que sa présentation soit
'conforme lorsqu'il sera copié dans Excel
Rg.Offset(1).Resize(NbEnr, Rst.Fields.Count).Value = TransposeSpecial(Tblo)
End If

'Redimensionnement des cellules.
Rg.CurrentRegion.Columns.AutoFit
Rg.CurrentRegion.Rows.AutoFit

'Sélection de la feuille au départ de la procédure
Worksheets(NomFeuille).Select

' Ferme la connection et le recordset
Rst.Close: Cnt.Close

'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
End Sub
'------------------------------------------

'Fonction requise par la procédure pour les
'versions antérieures à excel 200

'------------------------------------------
Function TransposeSpecial(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial = (Arr1)
End Function
'------------------------------------------






"GARAULT" <GARAULT@discussions.microsoft.com> a écrit dans le message de news:
448B740A-586C-4D22-92A4-6E19DF45DBE7@microsoft.com...
Bonjour,
J'ai un problème dans le 1er dossier joint .
lancez le fichier, et lancez visual basic.
dans le repertoire +feuilles executez la macro devisprepa2.
je voudrais que lorsque je clic sur numériser (ne pas tenir compte du lien
qu'il y a actuellement dessus) sa aille me chercher les info du fichiers (
voir lien n°2) et que sa me les envoies dans ma feuil 'prix vitrage'

est ce possible ? je sais pas comment faire .Merci

Voici le lien du fichier principale :

http://cjoint.com/?lCj7STwxSe


Voici le lien ou les informations sont contenues :

http://cjoint.com/?lCjYeiPqlW

premiere question : ou puis je trouver les bibliotheque pour l'ajouter
deuxieme question : (> CheminDb = "C:Classeur1.xls") moi le fichier c du
RTF sa fonctionne aussi ?

Si l'objectif est d'importer des données d'une feuille d'un classeur fermé
dans le classeur ouvert, voici un exemple général de code :

Tu dois ajouter la bibliothèque
"Microsoft Activex Data Objects 2.x Libaray"

Et tu adaptes, chemin , nom de fichier , nom de la feuille...

'----------------------------------------
Sub ImporterDesDonnéesDeAccess()

Dim X As Integer, C As Integer
Dim Cnt As New ADODB.Connection
Dim Rst As New ADODB.Recordset
Dim Rg As Range, Sh As Worksheet
Dim NbEnr As Long, CheminDb As String
Dim NNomFeuille As String
Dim Tblo As Variant, Requete As String

CheminDb = "C:Classeur1.xls"
NomFeuille = "Feuil1"
Requete = "Select * From [" & NomFeuille & "$]"

'La chaîne de connexion à une base de donnée Access
Cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & CheminDb & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'Ouverture du recordset
Rst.Open Requete, Cnt, adOpenStatic

'Si aucun enregistrement est trouvé lors de la requête
If Rst.RecordCount = 0 Then
MsgBox "Aucun enregistrement trouvé." & vbCrLf & _
"Fin de l'opération.", vbInformation + vbOKOnly, "Annulation"
' Ferme la connection et le recordset
Rst.Close: Cnt.Close
'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
Exit Sub
End If

'Éviter le rafraîchissement de l'écran
Application.ScreenUpdating = False

'Conserve dans une variable le nom de la feuille active.
NomFeuille = ThisWorkbook.ActiveSheet.Name

'Ajoute une nouvelle feuille où seront acheminées les données
Set Sh = Worksheets.Add

'détermine la cellule supérieur gauche où
'le recordset va être copié
With Sh
Set Rg = .Range("A1")
End With

'Si tu es intéressé de récupérer directement les noms
'des champs de ton recordset, tu peux utiliser ce
'qui suit :

Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
X = X + 1
Loop Until X = Rst.Fields.Count

'Section copiant le recordset dans excel

'La procédur va pouvoir choisir selon la version
'd'excel d'installer laquelle des méthodes choisir.

'Un test sur la version excel en cours ...
If Val(Mid(Application.Version, 1, InStr(1, _
Application.Version, ".") - 1)) > 8 Then
'EXCEL 2000 or 2002: La méthode CopyFromRecordset
Rg.Offset(1).CopyFromRecordset Rst
Else
'EXCEL 97 ou antérieur: Méthode GetRows

' GetRows transforme le recordset en tableau de base 0
Tblo = Rst.GetRows
'Première dimension tableau = Champ du recordset
'Deuxièm dimension Tableau = Données du recordset

'Détermine le nombre d'enregistrements
'Le +1 c'est pour tenir compte du tableau qui est de
'base 0 ... première cellule dans excel est cells(1,1)
NbEnr = UBound(Tblo, 2) + 1

'Transpose le tableau(tblo) pour que la première dimension
'devienne les données et que sa présentation soit
'conforme lorsqu'il sera copié dans Excel
Rg.Offset(1).Resize(NbEnr, Rst.Fields.Count).Value = TransposeSpecial(Tblo)
End If

'Redimensionnement des cellules.
Rg.CurrentRegion.Columns.AutoFit
Rg.CurrentRegion.Rows.AutoFit

'Sélection de la feuille au départ de la procédure
Worksheets(NomFeuille).Select

' Ferme la connection et le recordset
Rst.Close: Cnt.Close

'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
End Sub
'------------------------------------------

'Fonction requise par la procédure pour les
'versions antérieures à excel 200

'------------------------------------------
Function TransposeSpecial(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial = (Arr1)
End Function
'------------------------------------------






"GARAULT" <GARAULT@discussions.microsoft.com> a écrit dans le message de news:
448B740A-586C-4D22-92A4-6E19DF45DBE7@microsoft.com...
Bonjour,
J'ai un problème dans le 1er dossier joint .
lancez le fichier, et lancez visual basic.
dans le repertoire +feuilles executez la macro devisprepa2.
je voudrais que lorsque je clic sur numériser (ne pas tenir compte du lien
qu'il y a actuellement dessus) sa aille me chercher les info du fichiers (
voir lien n°2) et que sa me les envoies dans ma feuil 'prix vitrage'

est ce possible ? je sais pas comment faire .Merci

Voici le lien du fichier principale :

http://cjoint.com/?lCj7STwxSe


Voici le lien ou les informations sont contenues :

http://cjoint.com/?lCjYeiPqlW

Voici un exemple de code avec CSV

Je n'ai jamais essayé avec RTF....

Tu as une bonne raison de tenter de faire des découvertes !!!

'---------------------------
Sub MaRequête2()

Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, Rg As Range

Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:Test;" & _
"Extended Properties=""text;HDR=No;FMTÞlimited"""
Requete = "SELECT * From test1.csv"

Rst.Open Requete, Conn, adOpenKeyset, adLockOptimistic

Set Rg = Worksheets("Feuil2").Range("H1")
Rg.CopyFromRecordset Rst
Rst.Close: Conn.Close
Set Rg = Nothing
End Sub
'---------------------------



"GARAULT" <GARAULT@discussions.microsoft.com> a écrit dans le message de news:
03C60813-4C67-44E7-AB1E-387C3CB19AC4@microsoft.com...
premiere question : ou puis je trouver les bibliotheque pour l'ajouter
deuxieme question : (> CheminDb = "C:Classeur1.xls") moi le fichier c du
RTF sa fonctionne aussi ?

Si l'objectif est d'importer des données d'une feuille d'un classeur fermé
dans le classeur ouvert, voici un exemple général de code :

Tu dois ajouter la bibliothèque
"Microsoft Activex Data Objects 2.x Libaray"

Et tu adaptes, chemin , nom de fichier , nom de la feuille...

'----------------------------------------
Sub ImporterDesDonnéesDeAccess()

Dim X As Integer, C As Integer
Dim Cnt As New ADODB.Connection
Dim Rst As New ADODB.Recordset
Dim Rg As Range, Sh As Worksheet
Dim NbEnr As Long, CheminDb As String
Dim NNomFeuille As String
Dim Tblo As Variant, Requete As String

CheminDb = "C:Classeur1.xls"
NomFeuille = "Feuil1"
Requete = "Select * From [" & NomFeuille & "$]"

'La chaîne de connexion à une base de donnée Access
Cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & CheminDb & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'Ouverture du recordset
Rst.Open Requete, Cnt, adOpenStatic

'Si aucun enregistrement est trouvé lors de la requête
If Rst.RecordCount = 0 Then
MsgBox "Aucun enregistrement trouvé." & vbCrLf & _
"Fin de l'opération.", vbInformation + vbOKOnly, "Annulation"
' Ferme la connection et le recordset
Rst.Close: Cnt.Close
'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
Exit Sub
End If

'Éviter le rafraîchissement de l'écran
Application.ScreenUpdating = False

'Conserve dans une variable le nom de la feuille active.
NomFeuille = ThisWorkbook.ActiveSheet.Name

'Ajoute une nouvelle feuille où seront acheminées les données
Set Sh = Worksheets.Add

'détermine la cellule supérieur gauche où
'le recordset va être copié
With Sh
Set Rg = .Range("A1")
End With

'Si tu es intéressé de récupérer directement les noms
'des champs de ton recordset, tu peux utiliser ce
'qui suit :

Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
X = X + 1
Loop Until X = Rst.Fields.Count

'Section copiant le recordset dans excel

'La procédur va pouvoir choisir selon la version
'd'excel d'installer laquelle des méthodes choisir.

'Un test sur la version excel en cours ...
If Val(Mid(Application.Version, 1, InStr(1, _
Application.Version, ".") - 1)) > 8 Then
'EXCEL 2000 or 2002: La méthode CopyFromRecordset
Rg.Offset(1).CopyFromRecordset Rst
Else
'EXCEL 97 ou antérieur: Méthode GetRows

' GetRows transforme le recordset en tableau de base 0
Tblo = Rst.GetRows
'Première dimension tableau = Champ du recordset
'Deuxièm dimension Tableau = Données du recordset

'Détermine le nombre d'enregistrements
'Le +1 c'est pour tenir compte du tableau qui est de
'base 0 ... première cellule dans excel est cells(1,1)
NbEnr = UBound(Tblo, 2) + 1

'Transpose le tableau(tblo) pour que la première dimension
'devienne les données et que sa présentation soit
'conforme lorsqu'il sera copié dans Excel
Rg.Offset(1).Resize(NbEnr, Rst.Fields.Count).Value = TransposeSpecial(Tblo)
End If

'Redimensionnement des cellules.
Rg.CurrentRegion.Columns.AutoFit
Rg.CurrentRegion.Rows.AutoFit

'Sélection de la feuille au départ de la procédure
Worksheets(NomFeuille).Select

' Ferme la connection et le recordset
Rst.Close: Cnt.Close

'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
End Sub
'------------------------------------------

'Fonction requise par la procédure pour les
'versions antérieures à excel 200

'------------------------------------------
Function TransposeSpecial(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial = (Arr1)
End Function
'------------------------------------------






"GARAULT" <GARAULT@discussions.microsoft.com> a écrit dans le message de news:
448B740A-586C-4D22-92A4-6E19DF45DBE7@microsoft.com...
Bonjour,
J'ai un problème dans le 1er dossier joint .
lancez le fichier, et lancez visual basic.
dans le repertoire +feuilles executez la macro devisprepa2.
je voudrais que lorsque je clic sur numériser (ne pas tenir compte du lien
qu'il y a actuellement dessus) sa aille me chercher les info du fichiers (
voir lien n°2) et que sa me les envoies dans ma feuil 'prix vitrage'

est ce possible ? je sais pas comment faire .Merci

Voici le lien du fichier principale :

http://cjoint.com/?lCj7STwxSe


Voici le lien ou les informations sont contenues :

http://cjoint.com/?lCjYeiPqlW

oui mais ce dernier code que tu as donné je la place ou ?

Voici un exemple de code avec CSV

Je n'ai jamais essayé avec RTF....

Tu as une bonne raison de tenter de faire des découvertes !!!

'---------------------------
Sub MaRequête2()

Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, Rg As Range

Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:Test;" & _
"Extended Properties=""text;HDR=No;FMTÞlimited"""
Requete = "SELECT * From test1.csv"

Rst.Open Requete, Conn, adOpenKeyset, adLockOptimistic

Set Rg = Worksheets("Feuil2").Range("H1")
Rg.CopyFromRecordset Rst
Rst.Close: Conn.Close
Set Rg = Nothing
End Sub
'---------------------------



"GARAULT" <GARAULT@discussions.microsoft.com> a écrit dans le message de news:
03C60813-4C67-44E7-AB1E-387C3CB19AC4@microsoft.com...
premiere question : ou puis je trouver les bibliotheque pour l'ajouter
deuxieme question : (> CheminDb = "C:Classeur1.xls") moi le fichier c du
RTF sa fonctionne aussi ?

Si l'objectif est d'importer des données d'une feuille d'un classeur fermé
dans le classeur ouvert, voici un exemple général de code :

Tu dois ajouter la bibliothèque
"Microsoft Activex Data Objects 2.x Libaray"

Et tu adaptes, chemin , nom de fichier , nom de la feuille...

'----------------------------------------
Sub ImporterDesDonnéesDeAccess()

Dim X As Integer, C As Integer
Dim Cnt As New ADODB.Connection
Dim Rst As New ADODB.Recordset
Dim Rg As Range, Sh As Worksheet
Dim NbEnr As Long, CheminDb As String
Dim NNomFeuille As String
Dim Tblo As Variant, Requete As String

CheminDb = "C:Classeur1.xls"
NomFeuille = "Feuil1"
Requete = "Select * From [" & NomFeuille & "$]"

'La chaîne de connexion à une base de donnée Access
Cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & CheminDb & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'Ouverture du recordset
Rst.Open Requete, Cnt, adOpenStatic

'Si aucun enregistrement est trouvé lors de la requête
If Rst.RecordCount = 0 Then
MsgBox "Aucun enregistrement trouvé." & vbCrLf & _
"Fin de l'opération.", vbInformation + vbOKOnly, "Annulation"
' Ferme la connection et le recordset
Rst.Close: Cnt.Close
'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
Exit Sub
End If

'Éviter le rafraîchissement de l'écran
Application.ScreenUpdating = False

'Conserve dans une variable le nom de la feuille active.
NomFeuille = ThisWorkbook.ActiveSheet.Name

'Ajoute une nouvelle feuille où seront acheminées les données
Set Sh = Worksheets.Add

'détermine la cellule supérieur gauche où
'le recordset va être copié
With Sh
Set Rg = .Range("A1")
End With

'Si tu es intéressé de récupérer directement les noms
'des champs de ton recordset, tu peux utiliser ce
'qui suit :

Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
X = X + 1
Loop Until X = Rst.Fields.Count

'Section copiant le recordset dans excel

'La procédur va pouvoir choisir selon la version
'd'excel d'installer laquelle des méthodes choisir.

'Un test sur la version excel en cours ...
If Val(Mid(Application.Version, 1, InStr(1, _
Application.Version, ".") - 1)) > 8 Then
'EXCEL 2000 or 2002: La méthode CopyFromRecordset
Rg.Offset(1).CopyFromRecordset Rst
Else
'EXCEL 97 ou antérieur: Méthode GetRows

' GetRows transforme le recordset en tableau de base 0
Tblo = Rst.GetRows
'Première dimension tableau = Champ du recordset
'Deuxièm dimension Tableau = Données du recordset

'Détermine le nombre d'enregistrements
'Le +1 c'est pour tenir compte du tableau qui est de
'base 0 ... première cellule dans excel est cells(1,1)
NbEnr = UBound(Tblo, 2) + 1

'Transpose le tableau(tblo) pour que la première dimension
'devienne les données et que sa présentation soit
'conforme lorsqu'il sera copié dans Excel
Rg.Offset(1).Resize(NbEnr, Rst.Fields.Count).Value = TransposeSpecial(Tblo)
End If

'Redimensionnement des cellules.
Rg.CurrentRegion.Columns.AutoFit
Rg.CurrentRegion.Rows.AutoFit

'Sélection de la feuille au départ de la procédure
Worksheets(NomFeuille).Select

' Ferme la connection et le recordset
Rst.Close: Cnt.Close

'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
End Sub
'------------------------------------------

'Fonction requise par la procédure pour les
'versions antérieures à excel 200

'------------------------------------------
Function TransposeSpecial(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial = (Arr1)
End Function
'------------------------------------------






"GARAULT" <GARAULT@discussions.microsoft.com> a écrit dans le message de news:
448B740A-586C-4D22-92A4-6E19DF45DBE7@microsoft.com...
Bonjour,
J'ai un problème dans le 1er dossier joint .
lancez le fichier, et lancez visual basic.
dans le repertoire +feuilles executez la macro devisprepa2.
je voudrais que lorsque je clic sur numériser (ne pas tenir compte du lien
qu'il y a actuellement dessus) sa aille me chercher les info du fichiers (
voir lien n°2) et que sa me les envoies dans ma feuil 'prix vitrage'

est ce possible ? je sais pas comment faire .Merci

Voici le lien du fichier principale :

http://cjoint.com/?lCj7STwxSe


Voici le lien ou les informations sont contenues :

http://cjoint.com/?lCjYeiPqlW

ok j'ai ajouter Microsoft Activex Data Objects 2.x Libaray

mais le code suivant, je le met sur le bouton 'numériser' ?

Sub ImporterDesDonnéesDeAccess()

Dim X As Integer, C As Integer
Dim Cnt As New ADODB.Connection
Dim Rst As New ADODB.Recordset
Dim Rg As Range, Sh As Worksheet
Dim NbEnr As Long, CheminDb As String
Dim NNomFeuille As String
Dim Tblo As Variant, Requete As String

CheminDb = "C:Classeur1.xls"
NomFeuille = "Feuil1"
Requete = "Select * From [" & NomFeuille & "$]"

'La chaîne de connexion à une base de donnée Access
Cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & CheminDb & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'Ouverture du recordset
Rst.Open Requete, Cnt, adOpenStatic

'Si aucun enregistrement est trouvé lors de la requête
If Rst.RecordCount = 0 Then
MsgBox "Aucun enregistrement trouvé." & vbCrLf & _
"Fin de l'opération.", vbInformation + vbOKOnly, "Annulation"
' Ferme la connection et le recordset
Rst.Close: Cnt.Close
'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
Exit Sub
End If

'Éviter le rafraîchissement de l'écran
Application.ScreenUpdating = False

'Conserve dans une variable le nom de la feuille active.
NomFeuille = ThisWorkbook.ActiveSheet.Name

'Ajoute une nouvelle feuille où seront acheminées les données
Set Sh = Worksheets.Add

'détermine la cellule supérieur gauche où
'le recordset va être copié
With Sh
Set Rg = .Range("A1")
End With

'Si tu es intéressé de récupérer directement les noms
'des champs de ton recordset, tu peux utiliser ce
'qui suit :

Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
X = X + 1
Loop Until X = Rst.Fields.Count

'Section copiant le recordset dans excel

'La procédur va pouvoir choisir selon la version
'd'excel d'installer laquelle des méthodes choisir.

'Un test sur la version excel en cours ...
If Val(Mid(Application.Version, 1, InStr(1, _
Application.Version, ".") - 1)) > 8 Then
'EXCEL 2000 or 2002: La méthode CopyFromRecordset
Rg.Offset(1).CopyFromRecordset Rst
Else
'EXCEL 97 ou antérieur: Méthode GetRows

' GetRows transforme le recordset en tableau de base 0
Tblo = Rst.GetRows
'Première dimension tableau = Champ du recordset
'Deuxièm dimension Tableau = Données du recordset

'Détermine le nombre d'enregistrements
'Le +1 c'est pour tenir compte du tableau qui est de
'base 0 ... première cellule dans excel est cells(1,1)
NbEnr = UBound(Tblo, 2) + 1

'Transpose le tableau(tblo) pour que la première dimension
'devienne les données et que sa présentation soit
'conforme lorsqu'il sera copié dans Excel
Rg.Offset(1).Resize(NbEnr, Rst.Fields.Count).Value =
TransposeSpecial(Tblo)
End If

'Redimensionnement des cellules.
Rg.CurrentRegion.Columns.AutoFit
Rg.CurrentRegion.Rows.AutoFit

'Sélection de la feuille au départ de la procédure
Worksheets(NomFeuille).Select

' Ferme la connection et le recordset
Rst.Close: Cnt.Close

'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
End Sub
'------------------------------------------

'Fonction requise par la procédure pour les
'versions antérieures à excel 200

'------------------------------------------
Function TransposeSpecial(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial = (Arr1)
End Function
'------------------------------------------

Voici un exemple de code avec CSV

Je n'ai jamais essayé avec RTF....

Tu as une bonne raison de tenter de faire des découvertes !!!

'---------------------------
Sub MaRequête2()

Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, Rg As Range

Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:Test;" & _
"Extended Properties=""text;HDR=No;FMTÞlimited"""
Requete = "SELECT * From test1.csv"

Rst.Open Requete, Conn, adOpenKeyset, adLockOptimistic

Set Rg = Worksheets("Feuil2").Range("H1")
Rg.CopyFromRecordset Rst
Rst.Close: Conn.Close
Set Rg = Nothing
End Sub
'---------------------------



"GARAULT" <GARAULT@discussions.microsoft.com> a écrit dans le message de news:
03C60813-4C67-44E7-AB1E-387C3CB19AC4@microsoft.com...
premiere question : ou puis je trouver les bibliotheque pour l'ajouter
deuxieme question : (> CheminDb = "C:Classeur1.xls") moi le fichier c du
RTF sa fonctionne aussi ?

Si l'objectif est d'importer des données d'une feuille d'un classeur fermé
dans le classeur ouvert, voici un exemple général de code :

Tu dois ajouter la bibliothèque
"Microsoft Activex Data Objects 2.x Libaray"

Et tu adaptes, chemin , nom de fichier , nom de la feuille...

'----------------------------------------
Sub ImporterDesDonnéesDeAccess()

Dim X As Integer, C As Integer
Dim Cnt As New ADODB.Connection
Dim Rst As New ADODB.Recordset
Dim Rg As Range, Sh As Worksheet
Dim NbEnr As Long, CheminDb As String
Dim NNomFeuille As String
Dim Tblo As Variant, Requete As String

CheminDb = "C:Classeur1.xls"
NomFeuille = "Feuil1"
Requete = "Select * From [" & NomFeuille & "$]"

'La chaîne de connexion à une base de donnée Access
Cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & CheminDb & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'Ouverture du recordset
Rst.Open Requete, Cnt, adOpenStatic

'Si aucun enregistrement est trouvé lors de la requête
If Rst.RecordCount = 0 Then
MsgBox "Aucun enregistrement trouvé." & vbCrLf & _
"Fin de l'opération.", vbInformation + vbOKOnly, "Annulation"
' Ferme la connection et le recordset
Rst.Close: Cnt.Close
'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
Exit Sub
End If

'Éviter le rafraîchissement de l'écran
Application.ScreenUpdating = False

'Conserve dans une variable le nom de la feuille active.
NomFeuille = ThisWorkbook.ActiveSheet.Name

'Ajoute une nouvelle feuille où seront acheminées les données
Set Sh = Worksheets.Add

'détermine la cellule supérieur gauche où
'le recordset va être copié
With Sh
Set Rg = .Range("A1")
End With

'Si tu es intéressé de récupérer directement les noms
'des champs de ton recordset, tu peux utiliser ce
'qui suit :

Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
X = X + 1
Loop Until X = Rst.Fields.Count

'Section copiant le recordset dans excel

'La procédur va pouvoir choisir selon la version
'd'excel d'installer laquelle des méthodes choisir.

'Un test sur la version excel en cours ...
If Val(Mid(Application.Version, 1, InStr(1, _
Application.Version, ".") - 1)) > 8 Then
'EXCEL 2000 or 2002: La méthode CopyFromRecordset
Rg.Offset(1).CopyFromRecordset Rst
Else
'EXCEL 97 ou antérieur: Méthode GetRows

' GetRows transforme le recordset en tableau de base 0
Tblo = Rst.GetRows
'Première dimension tableau = Champ du recordset
'Deuxièm dimension Tableau = Données du recordset

'Détermine le nombre d'enregistrements
'Le +1 c'est pour tenir compte du tableau qui est de
'base 0 ... première cellule dans excel est cells(1,1)
NbEnr = UBound(Tblo, 2) + 1

'Transpose le tableau(tblo) pour que la première dimension
'devienne les données et que sa présentation soit
'conforme lorsqu'il sera copié dans Excel
Rg.Offset(1).Resize(NbEnr, Rst.Fields.Count).Value = TransposeSpecial(Tblo)
End If

'Redimensionnement des cellules.
Rg.CurrentRegion.Columns.AutoFit
Rg.CurrentRegion.Rows.AutoFit

'Sélection de la feuille au départ de la procédure
Worksheets(NomFeuille).Select

' Ferme la connection et le recordset
Rst.Close: Cnt.Close

'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
End Sub
'------------------------------------------

'Fonction requise par la procédure pour les
'versions antérieures à excel 200

'------------------------------------------
Function TransposeSpecial(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial = (Arr1)
End Function
'------------------------------------------






"GARAULT" <GARAULT@discussions.microsoft.com> a écrit dans le message de news:
448B740A-586C-4D22-92A4-6E19DF45DBE7@microsoft.com...
Bonjour,
J'ai un problème dans le 1er dossier joint .
lancez le fichier, et lancez visual basic.
dans le repertoire +feuilles executez la macro devisprepa2.
je voudrais que lorsque je clic sur numériser (ne pas tenir compte du lien
qu'il y a actuellement dessus) sa aille me chercher les info du fichiers (
voir lien n°2) et que sa me les envoies dans ma feuil 'prix vitrage'

est ce possible ? je sais pas comment faire .Merci

Voici le lien du fichier principale :

http://cjoint.com/?lCj7STwxSe


Voici le lien ou les informations sont contenues :

http://cjoint.com/?lCjYeiPqlW

voici le second code que tu m'as donné.
dois je modifier ' text ' de la 8eme ligne et ' test1.csv ' de la 9eme ?

Private Sub CommandButton1_Click()

Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, Rg As Range

Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:Documents and SettingsMétreur1Mes documentsAperçu
écran.RTF;" & _
"Extended Properties=""text;HDR=No;FMTÞlimited"""
Requete = "SELECT * From test1.csv"

Rst.Open Requete, Conn, adOpenKeyset, adLockOptimistic

Set Rg = Worksheets("Prix vitrage").Range("b25")
Rg.CopyFromRecordset Rst
Rst.Close: Conn.Close
Set Rg = Nothing


End Sub

Voici un exemple de code avec CSV

Je n'ai jamais essayé avec RTF....

Tu as une bonne raison de tenter de faire des découvertes !!!

'---------------------------
Sub MaRequête2()

Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, Rg As Range

Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:Test;" & _
"Extended Properties=""text;HDR=No;FMTÞlimited"""
Requete = "SELECT * From test1.csv"

Rst.Open Requete, Conn, adOpenKeyset, adLockOptimistic

Set Rg = Worksheets("Feuil2").Range("H1")
Rg.CopyFromRecordset Rst
Rst.Close: Conn.Close
Set Rg = Nothing
End Sub
'---------------------------



"GARAULT" <GARAULT@discussions.microsoft.com> a écrit dans le message de news:
03C60813-4C67-44E7-AB1E-387C3CB19AC4@microsoft.com...
premiere question : ou puis je trouver les bibliotheque pour l'ajouter
deuxieme question : (> CheminDb = "C:Classeur1.xls") moi le fichier c du
RTF sa fonctionne aussi ?

Si l'objectif est d'importer des données d'une feuille d'un classeur fermé
dans le classeur ouvert, voici un exemple général de code :

Tu dois ajouter la bibliothèque
"Microsoft Activex Data Objects 2.x Libaray"

Et tu adaptes, chemin , nom de fichier , nom de la feuille...

'----------------------------------------
Sub ImporterDesDonnéesDeAccess()

Dim X As Integer, C As Integer
Dim Cnt As New ADODB.Connection
Dim Rst As New ADODB.Recordset
Dim Rg As Range, Sh As Worksheet
Dim NbEnr As Long, CheminDb As String
Dim NNomFeuille As String
Dim Tblo As Variant, Requete As String

CheminDb = "C:Classeur1.xls"
NomFeuille = "Feuil1"
Requete = "Select * From [" & NomFeuille & "$]"

'La chaîne de connexion à une base de donnée Access
Cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & CheminDb & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'Ouverture du recordset
Rst.Open Requete, Cnt, adOpenStatic

'Si aucun enregistrement est trouvé lors de la requête
If Rst.RecordCount = 0 Then
MsgBox "Aucun enregistrement trouvé." & vbCrLf & _
"Fin de l'opération.", vbInformation + vbOKOnly, "Annulation"
' Ferme la connection et le recordset
Rst.Close: Cnt.Close
'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
Exit Sub
End If

'Éviter le rafraîchissement de l'écran
Application.ScreenUpdating = False

'Conserve dans une variable le nom de la feuille active.
NomFeuille = ThisWorkbook.ActiveSheet.Name

'Ajoute une nouvelle feuille où seront acheminées les données
Set Sh = Worksheets.Add

'détermine la cellule supérieur gauche où
'le recordset va être copié
With Sh
Set Rg = .Range("A1")
End With

'Si tu es intéressé de récupérer directement les noms
'des champs de ton recordset, tu peux utiliser ce
'qui suit :

Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
X = X + 1
Loop Until X = Rst.Fields.Count

'Section copiant le recordset dans excel

'La procédur va pouvoir choisir selon la version
'd'excel d'installer laquelle des méthodes choisir.

'Un test sur la version excel en cours ...
If Val(Mid(Application.Version, 1, InStr(1, _
Application.Version, ".") - 1)) > 8 Then
'EXCEL 2000 or 2002: La méthode CopyFromRecordset
Rg.Offset(1).CopyFromRecordset Rst
Else
'EXCEL 97 ou antérieur: Méthode GetRows

' GetRows transforme le recordset en tableau de base 0
Tblo = Rst.GetRows
'Première dimension tableau = Champ du recordset
'Deuxièm dimension Tableau = Données du recordset

'Détermine le nombre d'enregistrements
'Le +1 c'est pour tenir compte du tableau qui est de
'base 0 ... première cellule dans excel est cells(1,1)
NbEnr = UBound(Tblo, 2) + 1

'Transpose le tableau(tblo) pour que la première dimension
'devienne les données et que sa présentation soit
'conforme lorsqu'il sera copié dans Excel
Rg.Offset(1).Resize(NbEnr, Rst.Fields.Count).Value = TransposeSpecial(Tblo)
End If

'Redimensionnement des cellules.
Rg.CurrentRegion.Columns.AutoFit
Rg.CurrentRegion.Rows.AutoFit

'Sélection de la feuille au départ de la procédure
Worksheets(NomFeuille).Select

' Ferme la connection et le recordset
Rst.Close: Cnt.Close

'Libère la mémoire vive occupée par les objets
Set Rst = Nothing: Set Cnt = Nothing
Set Rg = Nothing: Set Sh = Nothing
End Sub
'------------------------------------------

'Fonction requise par la procédure pour les
'versions antérieures à excel 200

'------------------------------------------
Function TransposeSpecial(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial = (Arr1)
End Function
'------------------------------------------






"GARAULT" <GARAULT@discussions.microsoft.com> a écrit dans le message de news:
448B740A-586C-4D22-92A4-6E19DF45DBE7@microsoft.com...
Bonjour,
J'ai un problème dans le 1er dossier joint .
lancez le fichier, et lancez visual basic.
dans le repertoire +feuilles executez la macro devisprepa2.
je voudrais que lorsque je clic sur numériser (ne pas tenir compte du lien
qu'il y a actuellement dessus) sa aille me chercher les info du fichiers (
voir lien n°2) et que sa me les envoies dans ma feuil 'prix vitrage'

est ce possible ? je sais pas comment faire .Merci

Voici le lien du fichier principale :

http://cjoint.com/?lCj7STwxSe


Voici le lien ou les informations sont contenues :

http://cjoint.com/?lCjYeiPqlW

Pour ajouter la bibliothèque :
Tu ouvres la fenêtre de l'éditeur de code : Alt + F11
Barre de menus / outils / références /
et tu coches dans la liste :
"Microsoft Activex Data 2..x Library"

ADO ne peut pas ouvrir un fichier ayant l'extension .DOC ou .RTF
parce que lors de l'enregistrement de ce type de fichier, le fichier
ne contient pas seulement les données mais tous les éléments de
la mise en page... si tu veux voir ce que ça donne, dans l'explorateur
de Windows, modifie l'extension du fichier de .RTF en .TXT et ouvre
le fichier avec Notepad... Maintenant tu as une petite idée pourquoi
ADO ne peut pas lire ces données !!!

Si tu tiens à utiliser ADO, il va falloir que tu ouvres avec Word ton fichier
.RTF et que tu demandes à Word de sauvegarder le fichier avec l'extension
.TXT ou CSV ..-> ceci peut se faire par automation...Et par la suite
appliquer la procédure suivante.

Les 2 procédures suivantes devraient faire le boulot... tu n'as que
la valeur de 3 variables à modifier ....

Pour ce qui est du reste ... c'est à dire où copier ces procédures
comment organiser ton application... à toi de trouver et d'appliquer
ce qui te convient !


'----------------------------------------
Sub Test()

Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, Rg As Range
Dim Chemin As String, Fichier As String
Dim FileTemp As String

Chemin = "C:" ' à déterminer
Fichier = "Denis.RTF" ' à déterminer

'FileTemp : C'est le nom que va prendre la version .txt
'du fichier originale. Le fichier créé est
'détruit à la fin de la procédure. Tu peux conserver
'Le même nom pour toutes tes opérations

FileTemp = "c:denis.txt" ' à déterminer

'Enregistrement du fichier originale sous un autre Format
NewFileVersion Chemin & Fichier, FileTemp

Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & ";" & _
"Extended Properties=""text;HDR=No;FMTÞlimited"""

Requete = "SELECT * From " & FileTemp

Rst.Open Requete, Conn, adOpenKeyset, adLockOptimistic

Set Rg = Worksheets("Feuil1").Range("A1")
Rg.CopyFromRecordset Rst
Rst.Close: Conn.Close
Set Rg = Nothing
Kill FileTemp
End Sub

'-------------------------------------
Sub NewFileVersion(File As String, FileTemp As String)

Dim Wd As Word.Application
Dim Dc As Document
Set Wd = CreateObject("Word.Application")
With Wd
.Visible = True ' Optionnel, mettre à false
'pour ne rien voir ...
Set Dc = .documents.Open(File)
Dc.SaveAs Filename:=FileTemp, FileFormat:=wdFormatText
Dc.Close
.Quit
End With
End Sub
'-------------------------------------

Dans la deuxième procédure :

Modifie ces 2 lignes par
Dim Wd As Word.Application
Dim Dc As Document

Dim Wd As Object
Dim Dc As Object

Ceci pour empêcher d'avoir à ajouter la référence Word
à ton application.




"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
OGfWRJ6EHHA.1784@TK2MSFTNGP06.phx.gbl...
Pour ajouter la bibliothèque :
Tu ouvres la fenêtre de l'éditeur de code : Alt + F11
Barre de menus / outils / références /
et tu coches dans la liste :
"Microsoft Activex Data 2..x Library"

ADO ne peut pas ouvrir un fichier ayant l'extension .DOC ou .RTF
parce que lors de l'enregistrement de ce type de fichier, le fichier
ne contient pas seulement les données mais tous les éléments de
la mise en page... si tu veux voir ce que ça donne, dans l'explorateur
de Windows, modifie l'extension du fichier de .RTF en .TXT et ouvre
le fichier avec Notepad... Maintenant tu as une petite idée pourquoi
ADO ne peut pas lire ces données !!!

Si tu tiens à utiliser ADO, il va falloir que tu ouvres avec Word ton fichier
.RTF et que tu demandes à Word de sauvegarder le fichier avec l'extension
.TXT ou CSV ..-> ceci peut se faire par automation...Et par la suite
appliquer la procédure suivante.

Les 2 procédures suivantes devraient faire le boulot... tu n'as que
la valeur de 3 variables à modifier ....

Pour ce qui est du reste ... c'est à dire où copier ces procédures
comment organiser ton application... à toi de trouver et d'appliquer
ce qui te convient !


'----------------------------------------
Sub Test()

Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, Rg As Range
Dim Chemin As String, Fichier As String
Dim FileTemp As String

Chemin = "C:" ' à déterminer
Fichier = "Denis.RTF" ' à déterminer

'FileTemp : C'est le nom que va prendre la version .txt
'du fichier originale. Le fichier créé est
'détruit à la fin de la procédure. Tu peux conserver
'Le même nom pour toutes tes opérations

FileTemp = "c:denis.txt" ' à déterminer

'Enregistrement du fichier originale sous un autre Format
NewFileVersion Chemin & Fichier, FileTemp

Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & ";" & _
"Extended Properties=""text;HDR=No;FMTÞlimited"""

Requete = "SELECT * From " & FileTemp

Rst.Open Requete, Conn, adOpenKeyset, adLockOptimistic

Set Rg = Worksheets("Feuil1").Range("A1")
Rg.CopyFromRecordset Rst
Rst.Close: Conn.Close
Set Rg = Nothing
Kill FileTemp
End Sub

'-------------------------------------
Sub NewFileVersion(File As String, FileTemp As String)

Dim Wd As Word.Application
Dim Dc As Document
Set Wd = CreateObject("Word.Application")
With Wd
.Visible = True ' Optionnel, mettre à false
'pour ne rien voir ...
Set Dc = .documents.Open(File)
Dc.SaveAs Filename:=FileTemp, FileFormat:=wdFormatText
Dc.Close
.Quit
End With
End Sub
'-------------------------------------

J'ai testé ton fichier, et je n'ai au aucun problème à importer tes données
dans une feuille d'excel.

Sauf qu'après l'importation, tu devras ajouter une petite macro pour
la mise en page des données. pour ce faire:
barre des menus / Données / Convertir / délimité / séparateur : Tabulation...

Si tu utilises l'enregistreur de macro, tu devrais obtenir l'essentiel du code...



"GARAULT" <GARAULT@discussions.microsoft.com> a écrit dans le message de news:
06A59FD0-D7BA-4A56-B002-1B3DC844393A@microsoft.com...
Euh vous pouvez jettez un oeil je crois que j'ai fais une erreure et du coup
plus rien marche.
merci

le fichier exel :
http://cjoint.com/?lDoflIwOIY

le fichier en rtf:
http://cjoint.com/?lDohn6zalh

Dans la deuxième procédure :

Modifie ces 2 lignes par
Dim Wd As Word.Application
Dim Dc As Document

Dim Wd As Object
Dim Dc As Object

Ceci pour empêcher d'avoir à ajouter la référence Word
à ton application.




"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
OGfWRJ6EHHA.1784@TK2MSFTNGP06.phx.gbl...
Pour ajouter la bibliothèque :
Tu ouvres la fenêtre de l'éditeur de code : Alt + F11
Barre de menus / outils / références /
et tu coches dans la liste :
"Microsoft Activex Data 2..x Library"

ADO ne peut pas ouvrir un fichier ayant l'extension .DOC ou .RTF
parce que lors de l'enregistrement de ce type de fichier, le fichier
ne contient pas seulement les données mais tous les éléments de
la mise en page... si tu veux voir ce que ça donne, dans l'explorateur
de Windows, modifie l'extension du fichier de .RTF en .TXT et ouvre
le fichier avec Notepad... Maintenant tu as une petite idée pourquoi
ADO ne peut pas lire ces données !!!

Si tu tiens à utiliser ADO, il va falloir que tu ouvres avec Word ton fichier
..RTF et que tu demandes à Word de sauvegarder le fichier avec l'extension
..TXT ou CSV ..-> ceci peut se faire par automation...Et par la suite
appliquer la procédure suivante.

Les 2 procédures suivantes devraient faire le boulot... tu n'as que
la valeur de 3 variables à modifier ....

Pour ce qui est du reste ... c'est à dire où copier ces procédures
comment organiser ton application... à toi de trouver et d'appliquer
ce qui te convient !


'----------------------------------------
Sub Test()

Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, Rg As Range
Dim Chemin As String, Fichier As String
Dim FileTemp As String

Chemin = "C:" ' à déterminer
Fichier = "Denis.RTF" ' à déterminer

'FileTemp : C'est le nom que va prendre la version .txt
'du fichier originale. Le fichier créé est
'détruit à la fin de la procédure. Tu peux conserver
'Le même nom pour toutes tes opérations

FileTemp = "c:denis.txt" ' à déterminer

'Enregistrement du fichier originale sous un autre Format
NewFileVersion Chemin & Fichier, FileTemp

Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & ";" & _
"Extended Properties=""text;HDR=No;FMTÞlimited"""

Requete = "SELECT * From " & FileTemp

Rst.Open Requete, Conn, adOpenKeyset, adLockOptimistic

Set Rg = Worksheets("Feuil1").Range("A1")
Rg.CopyFromRecordset Rst
Rst.Close: Conn.Close
Set Rg = Nothing
Kill FileTemp
End Sub

'-------------------------------------
Sub NewFileVersion(File As String, FileTemp As String)

Dim Wd As Word.Application
Dim Dc As Document
Set Wd = CreateObject("Word.Application")
With Wd
.Visible = True ' Optionnel, mettre à false
'pour ne rien voir ...
Set Dc = .documents.Open(File)
Dc.SaveAs Filename:=FileTemp, FileFormat:=wdFormatText
Dc.Close
.Quit
End With
End Sub
'-------------------------------------

Dans ce fil, j'ai un message qui t'explique comment faire... faudrais que tu prennes le temps de le
lire :


Dans la deuxième procédure :

Modifie ces 2 lignes par
Dim Wd As Word.Application
Dim Dc As Document

Dim Wd As Object
Dim Dc As Object

Ceci pour empêcher d'avoir à ajouter la référence Word
à ton application.




"GARAULT" <GARAULT@discussions.microsoft.com> a écrit dans le message de news:
F4C05888-140C-410F-B83C-F75CB2CE727A@microsoft.com...
j'ai un bug a ce niveau

erreur de compilation
Type défini par l'utilisateur non défini
en surbrillant jaune la premiere ligne et surbrillant bleu ' Dim Wd As
Word.Application' pourquoi ?

Sub NewFileVersion(File As String, FileTemp As String)

Dim Wd As Word.Application
Dim Dc As Document
Set Wd = CreateObject("Word.Application")
With Wd
.Visible = True ' Optionnel, mettre à false
'pour ne rien voir ...
Set Dc = .documents.Open(File)
Dc.SaveAs Filename:=FileTemp, FileFormat:=wdFormatText
Dc.Close
.Quit
End With
End Sub

Pour ajouter la bibliothèque :
Tu ouvres la fenêtre de l'éditeur de code : Alt + F11
Barre de menus / outils / références /
et tu coches dans la liste :
"Microsoft Activex Data 2..x Library"

ADO ne peut pas ouvrir un fichier ayant l'extension .DOC ou .RTF
parce que lors de l'enregistrement de ce type de fichier, le fichier
ne contient pas seulement les données mais tous les éléments de
la mise en page... si tu veux voir ce que ça donne, dans l'explorateur
de Windows, modifie l'extension du fichier de .RTF en .TXT et ouvre
le fichier avec Notepad... Maintenant tu as une petite idée pourquoi
ADO ne peut pas lire ces données !!!

Si tu tiens à utiliser ADO, il va falloir que tu ouvres avec Word ton fichier
..RTF et que tu demandes à Word de sauvegarder le fichier avec l'extension
..TXT ou CSV ..-> ceci peut se faire par automation...Et par la suite
appliquer la procédure suivante.

Les 2 procédures suivantes devraient faire le boulot... tu n'as que
la valeur de 3 variables à modifier ....

Pour ce qui est du reste ... c'est à dire où copier ces procédures
comment organiser ton application... à toi de trouver et d'appliquer
ce qui te convient !


'----------------------------------------
Sub Test()

Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, Rg As Range
Dim Chemin As String, Fichier As String
Dim FileTemp As String

Chemin = "C:" ' à déterminer
Fichier = "Denis.RTF" ' à déterminer

'FileTemp : C'est le nom que va prendre la version .txt
'du fichier originale. Le fichier créé est
'détruit à la fin de la procédure. Tu peux conserver
'Le même nom pour toutes tes opérations

FileTemp = "c:denis.txt" ' à déterminer

'Enregistrement du fichier originale sous un autre Format
NewFileVersion Chemin & Fichier, FileTemp

Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & ";" & _
"Extended Properties=""text;HDR=No;FMTÞlimited"""

Requete = "SELECT * From " & FileTemp

Rst.Open Requete, Conn, adOpenKeyset, adLockOptimistic

Set Rg = Worksheets("Feuil1").Range("A1")
Rg.CopyFromRecordset Rst
Rst.Close: Conn.Close
Set Rg = Nothing
Kill FileTemp
End Sub

'-------------------------------------
Sub NewFileVersion(File As String, FileTemp As String)

Dim Wd As Word.Application
Dim Dc As Document
Set Wd = CreateObject("Word.Application")
With Wd
.Visible = True ' Optionnel, mettre à false
'pour ne rien voir ...
Set Dc = .documents.Open(File)
Dc.SaveAs Filename:=FileTemp, FileFormat:=wdFormatText
Dc.Close
.Quit
End With
End Sub
'-------------------------------------