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 |
