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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
Option Explicit
Sub ListingFichiers_EK()
Dim WbHisto As Workbook, WbWave As Workbook
Dim ShHisto1 As Worksheet, ShHisto2 As Worksheet, ShWave As Worksheet
Dim LigneHisto1 As Long
Dim Rep As String, Fichier As String, File_OnGoing As String, Path_OnGoing As String
Dim HeureDebut2, HeureFin2, TempsTotal2
HeureDebut2 = Timer
On Error GoTo Fin
Set WbHisto = ActiveWorkbook
With WbHisto
Set ShHisto1 = .Sheets("Feuil1")
Set ShHisto2 = .Sheets("Feuil2")
File_OnGoing = .Name 'on récupère le nom du fichier r?cap
Path_OnGoing = .Path 'on récupère le chemin sur le r?seau o? se trouve le fichier
Rep = Path_OnGoing & "\" 'avec la fonction ThisWorkbook.path il manque un \ donc on l'ajoute
End With
'suppression de l'ancien historique
ShHisto2.Range("A1").CurrentRegion.ClearContents
'création de l'historique
ShHisto1.Range("A1").CurrentRegion.Copy
ShHisto2.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
With ShHisto1
'suppression de l'ancien import
If .ListObjects.Count > 0 Then .ListObjects(1).Delete
.Range("A1").CurrentRegion.ClearContents
'définition des titres du tabeau
.Range("A1:H1") = Array("Nom du fichier", "Type de document", "Numéro", "Date de création", "Montant HT (?)", "Montant TTC (?)", "Commentaire 1", "Commentaire 2")
LigneHisto1 = 2
End With
Application.ScreenUpdating = False 'utiliser pour am?liorer la vitesse de la macro
Application.Calculation = xlCalculationManual 'utiliser pour am?liorer la vitesse de la macro
Fichier = Dir(Rep)
Do While Fichier <> "" 'boucle dans le r?pertoire
If Fichier <> File_OnGoing And Left(Fichier, 4) Like "Wave" Then
ShHisto1.Cells(LigneHisto1, "A") = Fichier
Set WbWave = Workbooks.Open(Rep & Fichier) 'ouverture d'un fichier comprenant le nom "wave"
Set ShWave = WbWave.Sheets(1)
With ShWave
'.Unprotect "wave" 'mot de passe du fichier verrouill?
ShHisto1.Cells(LigneHisto1, "B") = .Range("nom").Value
ShHisto1.Cells(LigneHisto1, "C") = .Range("numero").Value
ShHisto1.Cells(LigneHisto1, "D") = .Range("date").Value
ShHisto1.Cells(LigneHisto1, "E") = .Range("montantHT").Value
ShHisto1.Cells(LigneHisto1, "F") = .Range("montantTTC").Value
'.Protect "wave"
End With
WbWave.Close savechanges:=False
Set ShWave = Nothing: Set WbWave = Nothing
LigneHisto1 = LigneHisto1 + 1
End If
Fichier = Dir 'fichier suivant
Loop
If LigneHisto1 > 2 Then
With ShHisto1
'mise en forme du tableau
LigneHisto1 = .Cells(.Rows.Count, 1).End(xlUp).Row
.ListObjects.Add(xlSrcRange, .Range("$A$1:$H$" & LigneHisto1), , xlYes).Name = "Tableau4"
.ListObjects("Tableau4").TableStyle = "TableStyleLight2"
.Columns("A:F").EntireColumn.AutoFit
.Range("K1") = LigneHisto1
End With
End If
HeureFin2 = Timer
TempsTotal2 = HeureFin2 - HeureDebut2
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Temps total du traitement : " & Round(TempsTotal2, 1) & " seconde(s)", vbInformation, "Import des données Wave"
GoTo Fin
Fin:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Set WbHisto = Nothing: Set WbWave = Nothing
Set ShHisto1 = Nothing: Set ShHisto2 = Nothing: Set ShWave = Nothing
End Sub |
