Code qui fonctionne en pas à pas (F8), mais pas lors de l'exécution

Version imprimable

Bonjour,

j'ai un cas de figure assez étrange. J'ai besoin d'ouvrir des centaines de fichiers puis d'effectuer certaines instructions sur ces fichiers. Problème : lorsque j'ouvre le fichier avec un macro et que je déclare des plages dans ce classeur, le code ne fonctionne pas. Plus bizarre encore, lorsque j'exécute ce code en pas à pas, ça fonctionne.

Voici mon code que vous puissiez reproduire le problème chez vous (activer Microsoft Scripting Runtime dans les références) :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Sub titi() Dim systemeDeFichiers As Scripting.FileSystemObject Set systemeDeFichiers = New Scripting.FileSystemObject Dim repertoire As Folder Set repertoire = systemeDeFichiers.GetFolder(ThisWorkbook.Path) Dim fichier As File Dim i As Integer Let i = 0 For Each fichier In repertoire.Files If InStr(fichier.Name, "Equity") <> 0 Then i = i + 1 Debug.Print i Dim classeur As Workbook Set classeur = Application.Workbooks.Open(fichier.Path) Dim plage As Range Set plage = classeur.Worksheets(1).Range("AJ1, AM1, AP1") (Instructions) End If Next fichier End Sub
Le code s'arrête à l'instanciation de plage, alors que normalement, le classeur est bien ouvert. Quand on le fait pas à pas, tout fonctionne parfaitement. Quelqu'un a une idée ? Est-ce que ce serait lié au fait que le classeur (un peu volumineux et qui met quelques secondes à s'ouvrir) n'est pas bien ouvert au moment de l'exécution de cette ligne (alors que quand on le fait en pas à pas, il a le temps de s'ouvrir) ? J'ai tenté des trucs avec des while Workbooks.count=1 DoEvents...sans succès...

Je vous remercie

Bonjour Anova, bonjour le forum,

Peut-être comme ça :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub titi()
Dim systemeDeFichiers As Scripting.FileSystemObject
Dim repertoire As Folder
Dim fichier As File
Dim i As Integer
Dim classeur As Workbook
Dim plage As Range
 
Set systemeDeFichiers = New Scripting.FileSystemObject
Set repertoire = systemeDeFichiers.getfolder(ThisWorkbook.Path)
Let i = 0
For Each fichier In repertoire.Files
    If InStr(fichier.Name, "Equity") <> 0 Then
        i = i + 1
        Debug.Print i
        Set classeur = Application.Workbooks.Open(fichier.Path)
        With classeur.Worksheets(1)
            Set plage = Application.Union(.Range("AJ1"), .Range("AM1"), .Range("AP1"))
        End With
        '(Instructions)
    End If
Next fichier
End Sub

02/09/2014, 16h14
Marc-L

Bonjour, bonjour !

Les variables doivent être déclarées au début de la procédure.

Sinon FSO n'est pas nécessaire, utiliser la fonction Dir serait peut-être plus simple …

Bonjour,

Avec une petite fonction pour la récup. des classeurs :

Code:

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
 
Sub Classeurs()
 
    Dim Cls As Workbook
    Dim plage As Range
    Dim Tbl
    Dim I As Integer
 
    'seuls les classeurs contenant "Equity" et d'extension xls seront retournés, à adapter...
    Tbl = RecupFichiers(ThisWorkbook.Path & "\", "Equity", "xls")
 
    For I = 1 To UBound(Tbl)
 
        Set Cls = Workbooks.Open(Tbl(I))
        Set plage = Cls.Worksheets(1).Range("AJ1, AM1, AP1")
 
        'suite des instructions...
 
    Next I
 
End Sub
Function RecupFichiers(Chemin As String, Critere As String, Extension As String) As String()
 
    Dim TableauFichiers() As String
    Dim Fichier As String
    Dim I As Integer
 
    Fichier = Dir(Chemin & "*" & Critere & "*." & Extension)
 
    Do While (Len(Fichier) > 0)
 
        I = I + 1
 
        ReDim Preserve TableauFichiers(1 To I)
 
        TableauFichiers(I) = Fichier
 
        Fichier = Dir()
 
    Loop
 
    RecupFichiers = TableauFichiers()
 
End Function

Hervé.