[XL-2010] - MsgBox après un Loop qui ne s'affiche pas

Version imprimable

Bonjour à tous,

Je suis novice en VBA (et nouveau sur ce forum) et tente actuellement de créer un fichier principal contenant une macro qui collecte des données dans plusieurs fichiers.

J'aimerais qu'un boîte de dialogue s'affiche après le processus en m'indiquant le temps qui a été nécessaire.

Pour l'instant j'ai le code ci-dessous, mais le MsgBox ne s'affiche pas à la fin. Quelqu'un aurait une idée de la raison?

D'avance je vous remercie pour votre aide!

Salutations.

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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Sub LoopThroughDirectory()
Application.ScreenUpdating = False
 
Dim MyFile As String
Dim Filepath As String
Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Dim StartTime As Double
Dim SecondsElapsed As Double
 
Filepath = "P:\MACRO TEST\RCSA files\"
MyFile = Dir(Filepath)
StartTime = Timer
 
Do While Len(MyFile) > 0
'Do While MyFile <> ""
'While (MyFile <> "")
    If MyFile = "Zmaster.xlsm" Then
    Exit Sub
    End If
    Application.DisplayAlerts = False
    Workbooks.Open (Filepath & MyFile)
    Worksheets("Risks").Activate
    Set sht = Worksheets("Risks")
    Set StartCell = Range("J6")
    'Range("J6", Range("S65536").End(xlUp)).Select
    'Range("J6").Select
    Worksheets("Risks").UsedRange
    LastRow = sht.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    sht.Range("J6:AN" & LastRow).Select
    'Selection.CurrentRegion.Select
    Selection.Copy
    Windows("Zmaster.xlsm").Activate
        If Range("J6").Value = "" Then
        Range("J6").Select
        ActiveSheet.Paste
        Else
        lMaxRows = Cells(Rows.Count, "J").End(xlUp).Row
        Range("J" & lMaxRows + 1).Select
        ActiveSheet.Paste
        End If
    ActiveWindow.ActivateNext
    ActiveWorkbook.Close
 
 
    MyFile = Dir 'get next file name
 
'Wend
Loop
 
Application.DisplayAlerts = True
 
SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
 
 
End Sub

25/01/2016, 18h52
Menhir

Tu devrais un peu indenter ton code et le mettre entre balise CODE pour qu'il soit plus lisible.

Es-tu sûr que la macro se termine ou dois-tu l'arrêter manuellement ?

Bonjour Menhir,

Je remets mon code entre balises code pour une meilleure lecture:

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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
 
Sub LoopThroughDirectory()
Application.ScreenUpdating = False
 
Dim MyFile As String
Dim Filepath As String
Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Dim StartTime As Double
Dim SecondsElapsed As Double
 
Filepath = "P:\MACRO TEST\RCSA files\"
MyFile = Dir(Filepath)
StartTime = Timer
 
Do While Len(MyFile) > 0
'Do While MyFile <> ""
'While (MyFile <> "")
    If MyFile = "Zmaster.xlsm" Then
    Exit Sub
    End If
    Application.DisplayAlerts = False
    Workbooks.Open (Filepath & MyFile)
    Worksheets("Risks").Activate
    Set sht = Worksheets("Risks")
    Set StartCell = Range("J6")
    'Range("J6", Range("S65536").End(xlUp)).Select
    'Range("J6").Select
    Worksheets("Risks").UsedRange
    LastRow = sht.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    sht.Range("J6:AN" & LastRow).Select
    'Selection.CurrentRegion.Select
    Selection.Copy
    Windows("Zmaster.xlsm").Activate
        If Range("J6").Value = "" Then
        Range("J6").Select
        ActiveSheet.Paste
        Else
        lMaxRows = Cells(Rows.Count, "J").End(xlUp).Row
        Range("J" & lMaxRows + 1).Select
        ActiveSheet.Paste
        End If
    ActiveWindow.ActivateNext
    ActiveWorkbook.Close
 
 
    MyFile = Dir 'get next file name
 
'Wend
Loop
 
Application.DisplayAlerts = True
 
SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
 
 
End Sub

J'ai essayé la macro et visiblement elle s'arrête seule (sinon j'imagine que ça reprendrait en boucle les mêmes données de fichiers traités préalablement, or cela s'arrête une fois tous les fichiers du dossier copiés ).

Cependant, en la lançant étape par étape, je remarque qu'à aucun moment la macro ne dépasse la ligne "Loop" pour entamer le Msgbox. Je ne comprends pas pourquoi :?

25/01/2016, 21h40
parmi
Bonjour,

Il y a des chances que la macro rencontre ce fichier et sorte de la Sub avant la fin...
Code:

1 2 3 If MyFile = "Zmaster.xlsm" Then Exit Sub End If
Tu pourrais changer le Exit Sub par Exit Do
26/01/2016, 10h12
Tomapaco

Bonjour parmi,

En effet en le remplaçant par le Exit Do ça marche.

Merci beaucoup! :)