Bug avec Ado

[F.LAUNAY]

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

 

[michel]

Bonjour F.Launay

ce n'est pas evident sans voir la structure du classeur
il s'agit peut etre des entetes qui ne sont pas pris en compte dans l'exemple

tu peux essayer cette adaptation
( j'ai testé sur 15 colonnes et 4500 lignes sans aucun probleme )


'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
Feuil1.Range("A10:H100").ClearContents
Dossier = "C:\Documents and Settings\michel\dossier\general\excel\"
Nomfichier = "Classeur2.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
Dim Target As Range
Dim i As Integer

Set Target = Cells(11, 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


If Not rsData.EOF Then
For i = 0 To rsData.Fields.Count - 1 'recupere les entetes
Range("A10").Offset(0, i) = rsData.Fields(i).Name
Next
Target.CopyFromRecordset rsData
Else
MsgBox "Aucun enregistrement renvoyé.", vbCritical

End If

''' On nettoie pour finir...
rsData.Close
Set rsData = Nothing

End Sub



bon dimanche
MichelXld

 

[F.LAUNAY]

Merci Michel
j'ai un classeur avec 3 feuilles et un bout de code macro.
bien reçu ton correctif, mais le probleme demeure
je vais continuer à chercher.....
je me demande si la reponse ne tient pas dans le
formatage en couleur de ces cellules qui s'applique sur
2 colonnes quand les valeurs changent
Or la macro de recuperation prends en compte une colonne
mais pas l'autre bizarre!
je vais tester la macro sur d' autres fichiers
Bonne soirée

 

[michel]

rebonsoir F.Launay

peux tu placer sur le forum un exemple zippé (sans données personnelles )pour regarder tout ça plus en détail


en attendant je te souhaite une bonne soiree
MichelXld