F
F.LAUNAY
Guest
Bonjour à tous,
J’ai voulu utiliser cette macro publié par F SIGONNEAU
Elle fonctionne, très rapide, mais présente un bug :
Elle ne récupère pas toutes les datas inscrites dans une feuille, que ce
Soit du texte ou des données numériques saisies
Quelqu’un aurait il une idée pour corriger ce bug ?
Ci joint pour avis le code
Option Explicit
'IMPORTER LE CONTENU D'UNE FEUILLE DE CALCUL D'UN CLASSEUR FERMÉ
'(SEULES LES DONNÉES SONT IMPORTÉES, PAS LES MISES EN FORME)
Sub TestQuery() ' ADAPTATION FLA 20-02-05
Dim Dossier As String, Nomfichier As String, Fich As String, Nomfeuil As String
Application.ScreenUpdating = False
Feuil3.Range("A10:H100").ClearContents
Dossier = ActiveWorkbook.Path & "\"
Nomfichier = "cap.xls"
Fich = Dossier & Nomfichier
Nomfeuil$ = "Actuel"
Fich$ = Dossier & Nomfichier
QueryWorksheet Fich, Nomfeuil
End Sub
' Bug : la récupération est incomplète!
Public Sub QueryWorksheet(Nomfichier$, Feuille$)
'ROB BOVEY, MPEP; macro très rapide
'NÉCESSITE UNE RÉFÉRENCE À LA LIBRAIRIE
'MICROSOFT ACTIVEX DATA OBJECT 2.X LIBRARY
Dim rsData As Object 'ADODB.Recordset
Dim szConnect As String, szSQL As String, Fich As String, Target As Range
Set Target = Cells(10, 1)
''' Crée la chaîne de connexion
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Nomfichier & ";" & _
"Extended Properties=Excel 8.0;"
' La requête est basée sur le nom de la feuille. Ce nom
' doit se terminer par un $ et doit être entouré de crochets droits.
' Adapter ce nom à vos besoins
szSQL = "SELECT * FROM [" & Feuille & "$];"
Set rsData = CreateObject("ADODB.Recordset") 'New ADODB.Recordset
rsData.Open szSQL, szConnect, adOpenForwardOnly, _
adLockReadOnly ', adCmdText
''' Vérifie qu'on a bien reçu des données
If Not rsData.EOF Then
Target.CopyFromRecordset rsData
Else
MsgBox "Aucun enregistrement renvoyé.", vbCritical
End If
''' On nettoie pour finir...
rsData.Close
Set rsData = Nothing
End Sub
J’ai voulu utiliser cette macro publié par F SIGONNEAU
Elle fonctionne, très rapide, mais présente un bug :
Elle ne récupère pas toutes les datas inscrites dans une feuille, que ce
Soit du texte ou des données numériques saisies
Quelqu’un aurait il une idée pour corriger ce bug ?
Ci joint pour avis le code
Option Explicit
'IMPORTER LE CONTENU D'UNE FEUILLE DE CALCUL D'UN CLASSEUR FERMÉ
'(SEULES LES DONNÉES SONT IMPORTÉES, PAS LES MISES EN FORME)
Sub TestQuery() ' ADAPTATION FLA 20-02-05
Dim Dossier As String, Nomfichier As String, Fich As String, Nomfeuil As String
Application.ScreenUpdating = False
Feuil3.Range("A10:H100").ClearContents
Dossier = ActiveWorkbook.Path & "\"
Nomfichier = "cap.xls"
Fich = Dossier & Nomfichier
Nomfeuil$ = "Actuel"
Fich$ = Dossier & Nomfichier
QueryWorksheet Fich, Nomfeuil
End Sub
' Bug : la récupération est incomplète!
Public Sub QueryWorksheet(Nomfichier$, Feuille$)
'ROB BOVEY, MPEP; macro très rapide
'NÉCESSITE UNE RÉFÉRENCE À LA LIBRAIRIE
'MICROSOFT ACTIVEX DATA OBJECT 2.X LIBRARY
Dim rsData As Object 'ADODB.Recordset
Dim szConnect As String, szSQL As String, Fich As String, Target As Range
Set Target = Cells(10, 1)
''' Crée la chaîne de connexion
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Nomfichier & ";" & _
"Extended Properties=Excel 8.0;"
' La requête est basée sur le nom de la feuille. Ce nom
' doit se terminer par un $ et doit être entouré de crochets droits.
' Adapter ce nom à vos besoins
szSQL = "SELECT * FROM [" & Feuille & "$];"
Set rsData = CreateObject("ADODB.Recordset") 'New ADODB.Recordset
rsData.Open szSQL, szConnect, adOpenForwardOnly, _
adLockReadOnly ', adCmdText
''' Vérifie qu'on a bien reçu des données
If Not rsData.EOF Then
Target.CopyFromRecordset rsData
Else
MsgBox "Aucun enregistrement renvoyé.", vbCritical
End If
''' On nettoie pour finir...
rsData.Close
Set rsData = Nothing
End Sub