Modification d'une macro de récup de données

**Blop le bricoleur** · 16/07/2009, 08h07

Bonjour,

Je dispose d'une macro permettant d'aller chercher le contenu de diverses cellules dans des classeurs fermés. J'aimerais la modifier pour qu'a la place elle ouvre les classeurs, pioche les données et referme les classeurs. mais je n'ai pas la moindre idée de comment faire...

Le but étant de gagner du temps car cette macro est loooongue voir trèèès loooongue à s'executer. dès que je dépasse la dizaine de fichier à traiter.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Option Explicit
 
Sub extraction() 
Dim nbre As Long, lig As Long, cptr As Long
Dim Fichier As String
Dim txt As String
 
    nbre = Application.CountA(Range("B7:B1000")) 
 
    lig = ligdep
    Application.ScreenUpdating = False
    For cptr = 1 To nbre
        Fichier = Cells(lig, 2)
 
        txt = "'" & Chemin & "\[" & Fichier & "]Feuil1 (2)'!R"
 
       Cells(lig, 4) = ExecuteExcel4Macro(txt & "15C3")
       Cells(lig + 1, 4) = ExecuteExcel4Macro(txt & "20C3")
       Cells(lig + 2, 4) = ExecuteExcel4Macro(txt & "25C3")
       Cells(lig + 3, 4) = ExecuteExcel4Macro(txt & "30C3")
       Cells(lig + 4, 4) = ExecuteExcel4Macro(txt & "35C3")
       Cells(lig, 5) = ExecuteExcel4Macro(txt & "15C5")
       Cells(lig + 1, 5) = ExecuteExcel4Macro(txt & "20C5")
       Cells(lig + 2, 5) = ExecuteExcel4Macro(txt & "25C5")
       Cells(lig + 3, 5) = ExecuteExcel4Macro(txt & "30C5")
       Cells(lig + 4, 5) = ExecuteExcel4Macro(txt & "35C5")
       Cells(lig, 6) = ExecuteExcel4Macro(txt & "15C11")
       Cells(lig + 1, 6) = ExecuteExcel4Macro(txt & "20C13")
       Cells(lig + 2, 6) = ExecuteExcel4Macro(txt & "25C13")
       Cells(lig + 3, 6) = ExecuteExcel4Macro(txt & "30C13")
       Cells(lig + 4, 6) = ExecuteExcel4Macro(txt & "35C13")
        lig = lig + 5
 
    Next
 
End Sub

Si une personne sympatique aimerait m'apporter de l'aide

.

Merci !

**Jean-Philippe André** · 16/07/2009, 10h16

salut,
il faut que tu utilises un objet Excel.Workbook,
tu l'ouvres avec ta variable txt qui vaudra

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 txt = Chemin & "\" & Fichier

la manipulation se fera par des Range()

**Blop le bricoleur** · 16/07/2009, 11h31

Merci de ta réponse.

Le VBA n'étant pas vraiment mon fort j'ai fait pleins de test mais je ne suis arrivé à rien de potable...

J'ai rajouté un

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim test As Excel.Workbook

Et j'ai viré tout ce qui était en trop dans ma variable txt.

Par contre pour le reste je tatonne, le seul truc que j'ai réussi à faire c'est afficher le chemin de mon dossier à la place des valeurs des cellules... Ca aide pas

.

Une petite aide s'il vous plait ^^.

**aalex_38** · 16/07/2009, 12h19

J'aimerais la modifier pour qu'a la place elle ouvre les classeurs

Un exemple perso pour boucler dans un repertoire et ouvrir tous les fichiers :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Fichier = Dir(Repertoire & "*.xls")
 
Workbooks.Open Filename:=Repertoire & Fichier
 
Do While Len(Fichier) > 0
     Fichier = Dir()
     If Fichier = Empty Then
         Exit Do
     End If
     DoEvents
     Workbooks.Open Filename:=Repertoire & Fichier
 
 Loop

**Blop le bricoleur** · 16/07/2009, 13h23

Merci.

Mais ce serait pas plus pratique d'ouvrir les classeurs 1 par 1 ?

Parce que j'imagine pas le truc avec une centaine de fichiers qui s'ouvrent en même temps ^^.

Rhaaa je vais me jeter par la fenêtre si ça continue

. Je suis sur que le truc en lui même est pas super compliqué.

**Krovax** · 16/07/2009, 14h26

Bonjour
L'objectif tu ouvre 1 classeur tu lance ta macro tu ferme le classeur, tu ouvre un autre classeur tu lmance ta macro tu ferme le classeur,......

Donc après le workbook open tu met ton code ou un apelle vers ta macro (comme tu le sent) et tu fini par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Workbooks("Fichier").close true 'pour fermer et enregistrer

juste avant le loop

**aalex_38** · 16/07/2009, 16h13

Effectivement comme dit Krovax, dans mon exemple tu fais ta procédure juste après cette ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Workbooks.Open Filename:=Repertoire & Fichier 'Tu peux ouvrir en lecture seule avec readonly = true

ensuite tu peux faire toujours avant le loop

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Workbooks.Close SaveChanges:=False

**Blop le bricoleur** · 17/07/2009, 08h38

merci à vous 2 ! Bon je pense pouvoir y arriver maintenant.

Y'a juste un problème, c'est au niveau du

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Workbooks.Open Filename:=Repertoire & Fichier

j'ai une erreur d'inaccesibilité a mon repertoire. Un message du genre "votre dossier doit être en lecture seule ou crypté". Le problème c'est qu'il n'est pas crypté et que j'ai beau décocher la case "lecture seule" du dossier elle reviens tout le temps...

Etrange car avec mon ancienne macro j'accedais à ce dossier sans problème.

**Blop le bricoleur** · 17/07/2009, 10h26

Bon, j'ai réussi à regler mon problème d'accès au dossier.

J'ai par contre un autre problème du coté de ma procédure.
je fait comme ceci après le Workbook.open :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Cells(lig, 4) = test.Sheets("Feuil1(2)").Range("C15").Value
 
'etc pour les autres cellules

Ca me colle une erreur comme quoi ma variable "test" est est non définie. Pourtant j'ai bien mis un :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim test As Excel.Workbook

Jaudrait il que je fasse un Set test = ???? quoi ?

.
Merci de m'aider !

**Krovax** · 17/07/2009, 10h31

Oui il faux bien initialiser ta variable test excel ne va pas deviner ce que tu veux dire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
dim test as workbook
'ceci devrais fonctionner
set test=Workbooks.Open Filename:=Repertoire & Fichier

**Blop le bricoleur** · 17/07/2009, 10h54

Salut !

Excel n'a pas l'air d'aimer la forme de ce Set. Vu sa belle coloration rouge

.

**Krovax** · 17/07/2009, 11h05

Excuse moi j'aurais du tester
Il faut ouvrir puis utiliser le set

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
dim test as workbook
'ceci devrais fonctionner
Workbooks.Open Filename:=Repertoire & Fichier
set test=Workbooks(Fichier)

**Blop le bricoleur** · 17/07/2009, 12h36

T'excuse pas

.

Merci, ce code a l'air de fonctionner. Maintenant j'ai une erreur autre part (décidément). Le premier fichier s'ouvre bien, c'est au moment de prendre les 1eres données que ça plante...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Cells(lig, 4) = test.Sheets("Feuil1(2)").Range("C15").Value

Ai je fait une erreur ? Ca me met "erreur d'automation"

. Pas très clair comme type d'errreur.

**LeForestier** · 17/07/2009, 12h54

Bonjour,
Si tu n'a pas changer le début de ta macro, voir,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

lig = ligdep

Ce qu'il y a dans ligdep
Apparement ce n'est pas initialiser, donc = 0
Sinon, remet ta macro
A+

**Blop le bricoleur** · 17/07/2009, 13h48

Désolé, c'était parce qu'elle est appelée depuis un autre module.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Public Const ligdep As Byte = 7

Sinon ma macro maintenant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Option Explicit
 
Sub extraction() 
Dim nbre As Long, lig As Long, cptr As Long
Dim nom_fichier As String
Dim txt As String
Dim test As Workbook
fichier = Dir(txt) 
 
nbre = Application.CountA(Range("B7:B1000")) 
lig = ligdep
Application.ScreenUpdating = False
For cptr = 1 To nbre
nom_fichier = Cells(lig, 2)
txt = Chemin & "\" & nom_fichier
 
 
Workbooks.Open Filename:=txt 'chemin + nom du fichier
  Set test = Workbooks(nom_fichier)
 
 
Do While Len(nom_fichier) > 0 
     fichier = Dir() 
     If fichier = Empty Then 
         Exit Do 
     End If 
     DoEvents 
     Workbooks.Open Filename:=txt 
 
 
        Cells(lig, 4) = test.Sheets("Feuil1(2)").Range("C15").value
        Cells(lig + 1, 4) = test.Sheets("Feuil1(2)").Range("C20").value
        Cells(lig + 2, 4) = test.Sheets("Feuil1(2)").Range("C25").value
        Cells(lig + 3, 4) = test.Sheets("Feuil1(2)").Range("C30").value
        Cells(lig + 4, 4) = test.Sheets("Feuil1(2)").Range("C35").value
        Cells(lig, 5) = test.Sheets("Feuil1(2)").Range("E15").value
        Cells(lig + 1, 5) = test.Sheets("Feuil1(2)").Range("E20").value
        Cells(lig + 2, 5) = test.Sheets("Feuil1(2)").Range("E25").value
        Cells(lig + 3, 5) = test.Sheets("Feuil1(2)").Range("E30").value
        Cells(lig + 4, 5) = test.Sheets("Feuil1(2)").Range("E35").value
        Cells(lig, 6) = test.Sheets("Feuil1(2)").Range("K15").value
        Cells(lig + 1, 6) = test.Sheets("Feuil1(2)").Range("M20").value
        Cells(lig + 2, 6) = test.Sheets("Feuil1(2)").Range("M25").value
        Cells(lig + 3, 6) = test.Sheets("Feuil1(2)").Range("M30").value
        Cells(lig + 4, 6) = test.Sheets("Feuil1(2)").Range("M35").value
        lig = lig + 5
 
       Workbooks.Close SaveChanges:=False
 
 Loop 
 
    Next
 
End Sub

**ouskel'n'or** · 17/07/2009, 14h08

Envoyé par Krovax

Il faut ouvrir puis utiliser le set

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
dim test as workbook
'ceci devrais fonctionner
Workbooks.Open Filename:=Repertoire & Fichier
set test=Workbooks(Fichier)

ou bien

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

set test=Workbooks.Open(Filename:=Repertoire & Fichier)

A toutes fins utiles...

Edit
Pour l'erreur, laisse le temps au fichier de s'ouvrir. Plus les µp sont rapides, plus le décalage entre l'exécution de la macro et la lecture du fichier (tributaire de la vitesse du DD) est important.
Tu ajoutes DoEvents sur la ligne suivant l'ouverture du fichier et ça devrait régler le problème

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
set test=Workbooks.Open(Filename:=Repertoire & Fichier)
DoEvents

Tu as une explication dans l'aide en ligne à DoEvents (...)

**Krovax** · 17/07/2009, 19h31

Haa les parenthèse pourtant j'ai lut et relue le tuto a ce propos. Si on veut un retour on met des parenthèses et on les enlève sinon

Heureusement j'ai pas de corde sous la main

**Blop le bricoleur** · 21/07/2009, 14h41

Merci beaucoup ouskel'n'or, j'ai réalisé ces petits changement

.
Par contre maintenant j'ai une nouvelle erreur... Ca n'arretera jamais :p ?

L'erreur intervient au niveau du Set :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set test = Workbooks.Open(Filename:=txt)

Sachant que ma variable txt est :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

txt = Chemin & "\" & nom_fichier

Ca me met "c:\\blablabla\ chemin est introuvable"... Pourtant la macro arrive bien à ouvrir le fichier donc le chemin est bon en toute logique...

**ouskel'n'or** · 21/07/2009, 14h49

Quelle erreur as-tu ? J'espère que ta macro ne se nomme pas test()

Teste ça en adaptant le chemin et le nom de fichier

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub ReTest()
Dim NomFich As String, chemin As String
Dim CL1 As Workbook
    chemin = "D:\xls\"
    NomFich = "Classeur1.xls"
    Set CL1 = Workbooks.Open(chemin & NomFich)
End Sub

Bon après-midi

**Blop le bricoleur** · 21/07/2009, 15h30

Alors l'erreur est :

'erreur d'execution 1004'

'C:\\mes_fichiers\archives\' introuvable. Verifiez l'orthographe du classeur ou la validité de l'emplacement.

Non ma macro ne se nomme extraction

.

J'ai testé ton bout de code ça marche bien au niveau de l'ouverture/fermeture, c'est un bon point !
Mais en y ajoutant la partie extraction j'ai une erreur

'l'indice n'appartient pas à la séléction'

L'erreur intervient là :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Cells(lig, 4) = Sheets("Feuil1(2)").Range("C15")

Je vois pas d'où ça provient...

Bonne journée.

Modification d'une macro de récup de données [XL-2003]

Macros et VBA Excel

Discussions similaires

Partager

Partager