choisir un fichier et importer des données sans l'ouvir

[Nono]

Salut !

A partir d'un classeur A, je souhaite pouvoir choisir un fichier B parmis ceux présents dans un répertoire (comme dans Ouvrir...) sauf qu'au lieu qu'il s'ouvre, je n'importe qu'une sélection de cellules de B dans mon classeur A.

---------------------------------------------------------------

J'ai vu des progs permettant de faire fonctionner la fonction Ouvrir :

Sub zaza()
Set fs = Application.FileSearch
With fs
.LookIn = "C:\Documents and Settings\florence\Application
Data\Microsoft\Excel\"
.Filename = "*"
.Execute
For i = 1 To .FoundFiles.Count
MsgBox .FoundFiles(i)
Next i
If .FoundFiles.Count = 0 Then
MsgBox "Aucun fichier n'a été trouvé."
End If
End With
End Sub
---------------------------------------------------------------------------

J'ai vu des progs permettant d'importer des données Excel sans ouvrir de fichiers.


Transfert en bloc depuis un classeur fermé
Est ce qu'on peut sous un seul appel de fonction
transférer les valeurs d'un bloc de cellules "source"sur un classeur fermé à un
bloc de cellules "cible" ?

Il est possible de lire et de récupérer des plages entières de cellules dans un
classeur fermé en utilisant les objets ADO (ActiveX Data Objects).
Ci-dessous un exemple de code fonctionnel, à recopier dans un module standard du
VBAProject de ton classeur "cible". Ce classeur "cible" doit comporter une
référence à la bibliothèque
Microsoft ActiveX Data Objects 2.x Library.
C'est la procédure GetExternalData qui fait le travail. La procédure LitDatas se
contente de l'appeler en lui passant les paramètres voulus et en renvoyant les
données récupérées à l'endroit voulu.

'====================
Sub LitDatas()
Dim Fich$, Arr

Fich = "d:\TestDataToRead.xls"
'récup des données à partir de l'adresse d'une plage de cellules
GetExternalData Fich, "Feuil1", "A10:G20", False, Arr
'récup des données à partir du nom d'une plage de cellules
' GetExternalData Fich, "", "essainom", False, Arr
With ThisWorkbook.Sheets("Feuil1")
.Range("A1", .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)
'd'après Héctor Miguel, mpep
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

Frédéric Sigonneau

-----------------------------------------------------------------------------



Le problème c'est de faire le lien entre les 2 programmes !

Merci

 

[Thierry]

Bonsoir Nono,

Juste une pettie question, les fichiers sources sont-ils toujours les mêmes et au même endroit ? Auquel cas j'ai peut être une petite idée.

Par contre si ils sont variables dans leur noms, dans leurs emplacement et dans leur quantité... Là c'est plus délicat.

@+Thierry

 

[Nono]

Thierry,

Ils sont toujours au même endroit mais leurs noms et nombre peut varier.

Arnaud

 

[Robert]

Voici quelques macros qui fonctionnent, je les ai testées.
Elles ne réclament aucune référence supplémentaire.

'LES MACROS ORIGINALES DE J.WALKENBACH (traduc Flo)
'Aucune fonction VBA ne permet de récupérer la valeur d'une cellule
'dans un ficher fermé. On peut cependant profiter de la possibilité de travailler
'dans excel avec des fichiers liés. Cette astuce utilise une macro XL4
'qui fonctionne toujours sous excel 95, 97, 2000 et XP (2002).
'La fonction GetValue admet 4 arguments :
'Path : le disque dur, la partition , les répertoires et sous répertoires d'accès
' au fichier. Ex : "D:\mesdocuments\loisirs"
'File : le nom du classeur. Ex : "vacances.xls"
'Sheet : le nom de la feuille. Ex : "Méribel"
'Ref: L'adresse de la cellule. Ex : "C4"

Sub TestGetValue()
'Récupérer dans la feuille active 1000 lignes et 4 colonnes d'un fichier fermé
Dim P As String, f As String, S As String
Dim A As String
Dim C As Long, R As Long, I As Long
P = "D:\mesdocuments\loisirs"
f = "vacances.xls"
S = "Méribel"
'Vérifie l'existence du fichier, ajoute les séparateurs manquants
If (Right(P, 1) <> "\") Then P = P & "\"
If (Dir(P & f) <> "") Then
Range("A1").CurrentRegion.ClearContents
I = 0
Application.ScreenUpdating = False
For R = 1 To 1000
For C = 1 To 4
I = I + 1
Cells(R, C) = GetValue(P, f, S, Cells(R, C).Address)
Next C
Next R
Application.ScreenUpdating = True
End If
End Sub

Private Function GetValue(Path, File, Sheet, Ref)
'Récupération d'une valeur dans un fichier fermé
Dim Arg As String
'Crée l'argument de la fonction XL4
Arg = "'" & Path & "[" & File & "]" & Sheet & "'!" & Range(Ref) _
.Range("A1").Address(, , xlR1C1) '
'Exécute la macro XLM
GetValue = ExecuteExcel4Macro(Arg)
End Function

A+

Robert

 

[Arnaud]

Robert,

Merci pour le programme.
Malheureusemene je n'arrive pas à le faire marcher. Rien ne se passe, pas de message d'erreur... bizarre.
De plus malheureusement il suppose que soit connu le fichier à partir duquel on veut retirer les données. Or si on connait le répertoire, les fichiers eux peuvent varier dans leur nom et leur nombre.

Merci

Arnaud

 

[Robert]

Avec quel excel travailles-tu?

Le code que je t'ai envoyé fonctionne en excel 2000.

Pour les noms des fichiers et leur noms, il faut faire une boucle dans le genre:

a=dir(nom complet du répertoire & "\*.xls" ) ' a contient le nom du premier fichier xls du répertoire
do
'routine de lecture que je t'ai transmise précédemment
a=dir
loop while a<>""

Si tu as d'autres difficultés, contacte-moi pas e-mail avec si possible un exemple de ce que tu veux faire et qui ne fonctionne pas

A+

Robert

 

[Tonio]

bonjour à tous,
je suis en train d'essayer de reprendre le code de Robert: Sub Testgestvalue (). Mais mon excel ne reconnait pas get value. Est-ce due à la version d'excel? Comment puis-je faire?

Merci à tout le monde !!!!!!!

 

[Tonio]

choisir un fichier excel et importer des données

Bonjour à tous, j'ai trouver cette macro sur le forum mais je n'arrive pas à l'appliquer, mon excel ne reconnait pas getvalue. Quelqu'un peut-il m'aider?

Sub TestGetValue()
'Récupérer dans la feuille active 1000 lignes et 4 colonnes d'un fichier ferméApplication.ScreenUpdating = False
For R = 1 To 1000
For C = 1 To 4
Dim P As String, f As String, S As String
Dim A As String
Dim C As Long, R As Long, I As Long
P = "\\hf14-001\APPLI_IMMEUBLES"
f = "immeubles.xls"
S = "ImmeublesCaisses"
'Vérifie l'existence du fichier, ajoute les séparateurs manquants
If (Right(P, 1) <> "\") Then P = P & "\"
If (Dir(P & f) <> "") Then
Range("A1").CurrentRegion.ClearContents
I = 0

I = I + 1
Cells(R, C) = GetValue(P, f, S, Cells(R, C).Address)
Next C
Next R
Application.ScreenUpdating = True
End If
End Sub

Merci à tous