Nombre de fichiers restant

Version imprimable

Bonjour à tous,
Voici mon code :

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
61
62
63
64
Private Sub CommandButton1_Click()
 
On Error Resume Next
 
Dim chemin As String, KRCFile As String
Dim folder As Variant, box As Variant
Dim NBFichier As Integer
Dim wb As Workbook
 
'définit le répertoire contenant les fichiers
chemin = ThisWorkbook.Path & Application.PathSeparator
folder = "KRC_GB-BH\"
 
'tous les fichiers krc*.xlsx du folder
KRCFile = Dir(chemin & folder & "KRC" & "*.xlsx")
 
If KRCFile <> "" Then
'boucle => nombre de fichiers trouvés dans le folder
    While Not KRCFile = ""
        NBFichier = NBFichier + 1
        KRCFile = Dir
    Wend
Else: MsgBox "Not Files in the folder"
Exit Sub
End If
 
box = MsgBox("Find" & " " & NBFichier & " " & "file(s)" & " " & "?", vbYesNo + vbQuestion + vbApplicationModal + vbDefaultButton2, "")
 
KRCFile = Dir(chemin & folder & "KRC" & "*.xlsx")
 
If box = vbYes Then
    If KRCFile <> "" Then
        Application.StatusBar = "Old data erased"
        sh_GlobalKrc.Range("A5:O" & ActiveSheet.UsedRange.Rows.Count - 1).ClearContents
        Application.StatusBar = "Import in progess....."
        Application.ScreenUpdating = False
        Do While KRCFile <> ""
            Application.EnableEvents = False
            'ouvre le fichier trouvé
            Set wb = Workbooks.Open(chemin & folder & KRCFile)
            wb.Sheets("KRC").Unprotect ("celbud")
            If wb.Sheets("KRC").Range("k3") = "Oui / Ja" Then
                wb.Sheets("KRC").Range("C13:N" & wb.Sheets("KRC").UsedRange.Rows.Count).Copy
                sh_GlobalKrc.Range("B1048576").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, operation _
                    :=xlNone, skipblanks:=False, Transpose:=False
                'vide le presse papier
                Call ClearClipboard
            Else
            End If
            'ferme le fichier trouvé en cours
            wb.Close False
            Set wb = Nothing
            KRCFile = Dir
        Loop
        'MsgBox "Import OK"
        Columns("A:O").AutoFit
        Application.Goto reference:=Range("A5")
        Application.ScreenUpdating = True
        Application.StatusBar = False
        Application.EnableEvents = True
    End If
End If
 
End Sub

Je voudrais créer soit dans la barre d'état soit dans l'userform, une sorte de décompte de nombre de fichiers à ouvrir pour le copy/paste.

Merci pour votre aide

01/12/2018, 23h08
Patrice740

Citation:

Envoyé par rossemma

Je voudrais créer soit dans la barre d'état soit dans l'userform, une sorte de décompte de nombre de fichiers à ouvrir pour le copy/paste.

Bonjour,

Tu peux utiliser l'objet FileSearch du FSO (pour compter les fichiers) :
https://warin.developpez.com/access/fichiers/#LIII-B
02/12/2018, 11h28
patricktoulon

re

re
pourquoi aller chercher le gros lourdo de FSO alors que tu a deja tout !!!!????
ton do sur dir sert toit en pour stoker les nom de fichiers dans une variable tableau par exemple
et tes open/copy fait les dans une boucle sur ce tableau
de cette maniere tu connais le nombre de fichier avant d'ouvrir le premier tu a donc un debut et une fin pour un affichage dans la statusbar ou autre cela te sera plus facile
a savoir que dir sera toujours au moins 4 fois plus rapide que FSO
;)

Merci pour ton aide.

Quelque chose comme ceci :

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub test_tab()
 
Dim tab_exemple()
 
'Enregistrement des valeurs dans le tableau
For i = 0 To NBFichier
    tab_exemple(i) = KRCFile
Next
 
 
End Sub

re
un peu ca oui

je commencerais comme ca

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
Private Sub CommandButton1_Click()
 
On Error Resume Next
 
Dim chemin As String, KRCFile As String
Dim folder As Variant, box As Variant
Dim NBFichier As Long
Dim wb As Workbook, i&, tableau()
 
'définit le répertoire contenant les fichiers
chemin = ThisWorkbook.Path & Application.PathSeparator
folder = "KRC_GB-BH\"
 
'tous les fichiers krc*.xlsx du folder
KRCFile = Dir(chemin & folder & "KRC" & "*.xlsx")
 
Do While KRCFile <> ""
NBFichier = NBFichier + 1: ReDim Preserve tableau(1 To NBFichier): tableau(NBFichier) = chemin & chemin & folder & KRCFile
KRCFile = Dir
Loop
' tu a maintenant les chemins complets de tes fichiers dans le tableau 
 
For i = 1 To UBound(tableau)
'ici tu fait tes open/copy 
'workbooks.open tableau(i)
'...
'...etc...
'tu a donc le ubound qui est la limite et le i incrémenter pour tes affichage en statusbar 
next