Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Macro de GeeDee de lecture de fichiers fermés

Macro de GeeDee de lecture de fichiers fermés

3 réponses
Avatar
Sylvain
Bonjour,

En utilisant les macros suivantes la r=E9cup=E9ration de=20
donn=E9es externes en A1:A70 (par exemple) est ok par contre=20
si j'ex=E9cute une seconde fois la sub pour r=E9cup=E9rer des=20
donn=E9es en D20:G40 la recopie dans le classeur en cours=20
n'est pas bonne.

D'ou cela peut-il venir ?

Merci
Sylvain

Sub recup_donnees(rep, cellules As String, cell_dest As=20
String)
Dim Fich$, Arr

Fich =3D rep

'r=E9cup des donn=E9es =E0 partir de l'adresse d'une plage de=20
cellules
' R=E9cup des noms des collaborateurs
GetExternalData Fich, "donnees", cellules, False, Arr
=20
'r=E9cup des donn=E9es =E0 partir du nom d'une plage de cellules
' GetExternalData Fich, "donnees", "nom", False, Arr
With Sheets("donn=E9es")
.Range(cell_dest, .Cells(UBound(Arr, 1), UBound(Arr,=20
2))).Value =3D Arr
End With


End Sub

'=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D
=3D=3D=3D=3D=3D=3D=3D
'renvoie les valeurs d'une plage de cellules (srcRange)
'd'une feuille (srcSheet) d'un fichier (srcFile) ferm=E9
'dans un tableau (outArr)
'le param=E8tre TTL indique si la plage a ou non une ligne=20
d'ent=EAtes

Sub GetExternalData(srcFile As String, _
srcSheet As String, _
srcRange As String, _
TTL As Boolean, _
outArr As Variant)

Dim myConn As ADODB.Connection, myCmd As ADODB.Command
Dim HDR As String, myRS As ADODB.Recordset, RS_n As=20
Integer, RS_f As Integer
Dim Arr
=20
Set myConn =3D New ADODB.Connection
If TTL =3D True Then HDR =3D "Yes" Else HDR =3D "No"
myConn.Open "Provider=3DMicrosoft.Jet.OLEDB.4.0;" & _
"Data Source=3D" & srcFile & ";" & _
"Extended Properties=3D""Excel 8.0;" & _
"HDR=3D" & HDR & ";IMEX=3D1;"""
Set myCmd =3D New ADODB.Command
myCmd.ActiveConnection =3D myConn
If srcSheet =3D "" _
Then myCmd.CommandText =3D "SELECT * from `" & srcRange=20
& "`" _
Else myCmd.CommandText =3D "SELECT * from `" & srcSheet=20
& "$" & srcRange & "`"
Set myRS =3D New ADODB.Recordset
myRS.Open myCmd, , adOpenKeyset, adLockOptimistic
ReDim Arr(1 To myRS.RecordCount, 1 To myRS.Fields.Count)
myRS.MoveFirst
Do While Not myRS.EOF
For RS_n =3D 1 To myRS.RecordCount 'lignes
For RS_f =3D 0 To myRS.Fields.Count - 1 'colonnes
Arr(RS_n, RS_f + 1) =3D myRS.Fields(RS_f).Value
Next
myRS.MoveNext
Next
Loop
myConn.Close
Set myRS =3D Nothing
Set myCmd =3D Nothing
Set myConn =3D Nothing
=20
outArr =3D Arr
End Sub
Signaler un problème avec ce contenu

3 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
michdenis
Bonjour Sylvain,

Si tu travailles à partir d'une version excel 2000 ou plus récent :

Cette syntaxe est la plus simple
cell_dest.Resize(UBound(arr, 1)) = arr

Sinon essaie celle-ci :
With Sheets("données")
.Range(cell_dest, .Cells((UBound(arr, 1) + cell_dest.Row - 1), UBound(arr, 2))) = arr
End With



Salutations!



"Sylvain" a écrit dans le message de news:082401c3b59a$1f72bcb0$
Bonjour,

En utilisant les macros suivantes la récupération de
données externes en A1:A70 (par exemple) est ok par contre
si j'exécute une seconde fois la sub pour récupérer des
données en D20:G40 la recopie dans le classeur en cours
n'est pas bonne.

D'ou cela peut-il venir ?

Merci
Sylvain

Sub recup_donnees(rep, cellules As String, cell_dest As
String)
Dim Fich$, Arr

Fich = rep

'récup des données à partir de l'adresse d'une plage de
cellules
' Récup des noms des collaborateurs
GetExternalData Fich, "donnees", cellules, False, Arr

'récup des données à partir du nom d'une plage de cellules
' GetExternalData Fich, "donnees", "nom", False, Arr
With Sheets("données")
.Range(cell_dest, .Cells(UBound(Arr, 1), UBound(Arr,
2))).Value = Arr
End With


End Sub

'========================================================= ====== 'renvoie les valeurs d'une plage de cellules (srcRange)
'd'une feuille (srcSheet) d'un fichier (srcFile) fermé
'dans un tableau (outArr)
'le paramètre TTL indique si la plage a ou non une ligne
d'entêtes

Sub GetExternalData(srcFile As String, _
srcSheet As String, _
srcRange As String, _
TTL As Boolean, _
outArr As Variant)

Dim myConn As ADODB.Connection, myCmd As ADODB.Command
Dim HDR As String, myRS As ADODB.Recordset, RS_n As
Integer, RS_f As Integer
Dim Arr

Set myConn = New ADODB.Connection
If TTL = True Then HDR = "Yes" Else HDR = "No"
myConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & srcFile & ";" & _
"Extended Properties=""Excel 8.0;" & _
"HDR=" & HDR & ";IMEX=1;"""
Set myCmd = New ADODB.Command
myCmd.ActiveConnection = myConn
If srcSheet = "" _
Then myCmd.CommandText = "SELECT * from `" & srcRange
& "`" _
Else myCmd.CommandText = "SELECT * from `" & srcSheet
& "$" & srcRange & "`"
Set myRS = New ADODB.Recordset
myRS.Open myCmd, , adOpenKeyset, adLockOptimistic
ReDim Arr(1 To myRS.RecordCount, 1 To myRS.Fields.Count)
myRS.MoveFirst
Do While Not myRS.EOF
For RS_n = 1 To myRS.RecordCount 'lignes
For RS_f = 0 To myRS.Fields.Count - 1 'colonnes
Arr(RS_n, RS_f + 1) = myRS.Fields(RS_f).Value
Next
myRS.MoveNext
Next
Loop
myConn.Close
Set myRS = Nothing
Set myCmd = Nothing
Set myConn = Nothing

outArr = Arr
End Sub
Avatar
Bonjour,
Merci

Cela fonctionne bien.

Sylvain
-----Message d'origine-----
Bonjour Sylvain,

Si tu travailles à partir d'une version excel 2000 ou
plus récent :


Cette syntaxe est la plus simple
cell_dest.Resize(UBound(arr, 1)) = arr

Sinon essaie celle-ci :
With Sheets("données")
.Range(cell_dest, .Cells((UBound(arr, 1) +
cell_dest.Row - 1), UBound(arr, 2))) = arr

End With



Salutations!



"Sylvain" a écrit
dans le message de news:082401c3b59a$1f72bcb0

$
Bonjour,

En utilisant les macros suivantes la récupération de
données externes en A1:A70 (par exemple) est ok par contre
si j'exécute une seconde fois la sub pour récupérer des
données en D20:G40 la recopie dans le classeur en cours
n'est pas bonne.

D'ou cela peut-il venir ?

Merci
Sylvain

Sub recup_donnees(rep, cellules As String, cell_dest As
String)
Dim Fich$, Arr

Fich = rep

'récup des données à partir de l'adresse d'une plage de
cellules
' Récup des noms des collaborateurs
GetExternalData Fich, "donnees", cellules, False, Arr

'récup des données à partir du nom d'une plage de cellules
' GetExternalData Fich, "donnees", "nom", False, Arr
With Sheets("données")
.Range(cell_dest, .Cells(UBound(Arr, 1), UBound(Arr,
2))).Value = Arr
End With


End Sub

'======================== ========================= ========
=

=======
'renvoie les valeurs d'une plage de cellules (srcRange)
'd'une feuille (srcSheet) d'un fichier (srcFile) fermé
'dans un tableau (outArr)
'le paramètre TTL indique si la plage a ou non une ligne
d'entêtes

Sub GetExternalData(srcFile As String, _
srcSheet As String, _
srcRange As String, _
TTL As Boolean, _
outArr As Variant)

Dim myConn As ADODB.Connection, myCmd As ADODB.Command
Dim HDR As String, myRS As ADODB.Recordset, RS_n As
Integer, RS_f As Integer
Dim Arr

Set myConn = New ADODB.Connection
If TTL = True Then HDR = "Yes" Else HDR = "No"
myConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & srcFile & ";" & _
"Extended Properties=""Excel 8.0;" & _
"HDR=" & HDR & ";IMEX=1;"""
Set myCmd = New ADODB.Command
myCmd.ActiveConnection = myConn
If srcSheet = "" _
Then myCmd.CommandText = "SELECT * from `" & srcRange
& "`" _
Else myCmd.CommandText = "SELECT * from `" & srcSheet
& "$" & srcRange & "`"
Set myRS = New ADODB.Recordset
myRS.Open myCmd, , adOpenKeyset, adLockOptimistic
ReDim Arr(1 To myRS.RecordCount, 1 To myRS.Fields.Count)
myRS.MoveFirst
Do While Not myRS.EOF
For RS_n = 1 To myRS.RecordCount 'lignes
For RS_f = 0 To myRS.Fields.Count - 1 'colonnes
Arr(RS_n, RS_f + 1) = myRS.Fields(RS_f).Value
Next
myRS.MoveNext
Next
Loop
myConn.Close
Set myRS = Nothing
Set myCmd = Nothing
Set myConn = Nothing

outArr = Arr
End Sub



.



Avatar
gee-dee-
;-)))
Je vous jure.....
je ne suis pas à l'origine de cette macro !!!!

snif .... modestement cependant je le regrette !!!!
elle est bien pratique ;-)))
@+