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, ReadOnly:=True)
wb.Sheets("KRC").Unprotect ("1234")
If wb.Sheets("KRC").Range("k3") = "Oui / Ja" Then
wb.Sheets("KRC").Range("A13:N" & wb.Sheets("KRC").UsedRange.Rows.Count).Copy
sh_GlobalKrc.Range("A1048576").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 True
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 |
