Bonjour, j'ai ce code qui fonctionne à merveille.

Mais je voudrais ajouter dans la barre d'état à coté de "Import in progress.........." (ligne40) le nom du fichier en train de s'importer

Merci beaucoup

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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
Private Sub CBTNImport_Click()
 
    On Error Resume Next
 
    Dim chemin As String, Fichier As String, col1 As String, col2 As String
    Dim wb As Workbook
    Dim rep As Variant, folder As Variant
    Dim NBFichier As Integer
    Dim capt As Variant
 
    'Définit le répertoire contenant les fichiers
    chemin = ThisWorkbook.Path & Application.PathSeparator
    folder = "extract_SAP\"
 
    'Tous les fichiers xlsx du répertoire
    Fichier = Dir(chemin & folder & CBTNImport.Caption & "*.xlsx")
 
    'boucle pour le nombre de fichiers trouvés
    While Not Fichier = ""
        NBFichier = NBFichier + 1
        Fichier = Dir
    Wend
 
    capt = Application.WorksheetFunction.VLookup(CBTNImport.Caption, sh_parameters.Range("$A$3:$G$16"), 2, 0)
 
    rep = MsgBox("Do you want to continue and import" & " " & NBFichier & " " & "file(s)" & " " & _
        "for" & " " & capt & " ? ", vbYesNo + vbQuestion + vbApplicationModal + vbDefaultButton2, "")
 
    col1 = Application.WorksheetFunction.VLookup(CBTNImport.Caption, sh_parameters.Range("$A$3:$G$16"), 5, 0)
    col2 = Application.WorksheetFunction.VLookup(CBTNImport.Caption, sh_parameters.Range("$A$3:$G$16"), 7, 0)
 
    Fichier = Dir(chemin & folder & CBTNImport.Caption & "*.xlsx")
 
    If rep = vbYes Then
        If Fichier <> "" Then
            Application.StatusBar = "Old data erased"
            sh_month.Range(col1 & "2").Select
            sh_month.Range(col1 & "2" & ":" & col2 & ActiveSheet.UsedRange.Rows.Count - 1).ClearContents
            'MsgBox "Old data erased", vbOKOnly + vbExclamation, ""
            Application.StatusBar = "Import in progress.........."
            DoEvents
            Application.ScreenUpdating = False
            Do While Fichier <> ""
                'Désactive l'évènement
                Application.EnableEvents = False
                ' ouvre fichier trouvé
                Set wb = Workbooks.Open(chemin & folder & Fichier, ReadOnly:=True)
                ' copy/paste les données en valeurs
                Range("A2:C" & ActiveSheet.UsedRange.Rows.Count).Copy
                sh_month.Range(col1 & "1048576").End(xlUp).Offset(1, 0).PasteSpecial _
                        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Call ClearClipboard
                ' ferme le fichier trouvé en cours
                wb.Close True
                Set wb = Nothing
                Fichier = Dir
            Loop
            sh_month.Range(col1 & "2" & ":" & col2 & ActiveSheet.UsedRange.Rows.Count - 1).NumberFormat = "#,##0.00;[RED] -#,##0.00"
            Application.ScreenUpdating = True
            Application.StatusBar = False
            Call welcomeStatusBar
            MsgBox "The new data is imported", vbOKOnly + vbInformation, ""
            Application.Goto reference:=sh_month.Range(col1 & "1").Offset(, -1), Scroll:=True
            'Réactive l'évènement
            Application.EnableEvents = True
            'Sauve les données importées
            ThisWorkbook.Save
        Else
            MsgBox "One or more files do not exist"
        End If
    Else
    End If
 
    Exit Sub
 
End Sub