Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.
  • Initiateur de la discussion Initiateur de la discussion F.LAUNAY
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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
 
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
 
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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
2
Affichages
371
  • Question Question
Microsoft 365 Code VBA
Réponses
7
Affichages
622
Réponses
3
Affichages
1 K
Réponses
3
Affichages
518
Réponses
4
Affichages
332
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…