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
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
| Private Sub Workbook_Open()
Application.DisplayAlerts = False
myPath = "C:\Dossier\"
myFile = ActiveWorkbook.Name
'le nom du fichier est de la forme "fiche du YYYYMMDD"
'27 caracteres pour le chemin du fichier avant d'arriver aux infos Year et Month.
'28-31:year
'32-33:month
Application.StatusBar = True
'definition des valeurs min et max de la date.
'la valeur min est celle du premier enregistrement, la max celle du dernier.
workfile = Dir(mypath & "*.xls")
minyear = Mid(workfile, 28, 4)
minmonth = Mid(workfile, 32, 2)
Do While workfile <> ""
Application.StatusBar = "Traitement de " & workfile
maxyear = Mid(workfile, 28, 4)
maxmonth = Mid(workfile, 32, 2)
workfile = Dir()
Loop
'on détermine la première colonne à partir de laquelle il faudra remplir le tableau.
xpos = 2
'premiere annee: le mois de depart est le mois min.
'derniere annee: on vient modifier le mois max
jan = minmonth
dec = 12
For cyear = minyear To maxyear
If cyear Like maxyear Then
dec = maxmonth
End If
For cmonth = jan To dec
'RAZ des valeurs mensuelles
var1 = 0
var2 = 0
var3 = 0
'on ajoute un zéro à l'identifiant si le mois est < à 10 (pour avoir l'identifiant Mois sur 2 chiffres)
If cmonth < 10 Then
workfile = Dir(mypath & "Fiche du " & cyear & "0" & cmonth & "*.xls")
Else
workfile = Dir(mypath & "Fiche du " & cyear & cmonth & "*.xls")
End If
MsgBox (workfile)
'MsgBox (mypath & workfile & " - cyear = " & cyear & ", cmonth = " & cmonth)
Do While workfile <> ""
Application.StatusBar = "Traitement de " & workfile
var1 = var1 + Extraction("$F$14")
var2 = var2 + Extraction("$D$14")
var3 = var3 + Extraction("$E$14")
workfile = Dir()
Loop
'############ Enregistrement des valeurs dans la feuille Excel
Cells(1, xpos) = cyear
Cells(2, xpos) = cmonth
Cells(3, xpos) = var1
Cells(4, xpos) = var2
Cells(5, xpos) = var3
xpos = xpos + 1
Next cmonth
'(suppression des effets de minmonth (mois de départ première année)
jan = 1
Next cyear
'fermeture de la progress bar
Application.StatusBar = False
End Sub
Function Extraction(Champ As Variant) As Variant
Application.Volatile
Dim Source As ADODB.Connection
Dim Rst As ADODB.Recordset
Dim ADOCommand As ADODB.Command
Dim Fichier As String, Cellule As String, Feuille As String
'Adresse de la cellule contenant la donnée à récupérer
'Cellule = "B4:B4"
'Pour une plage de cellules, utilisez:
'Cellule = "A4:C10"
Feuille = "Feuil1$" 'n'oubliez pas d'ajouter $ au nom de la feuille.
'Chemin complet du classeur fermé
Fichier = mypath & workfile
Set Source = New ADODB.Connection
Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier & ";Extended Properties=""Excel 8.0;HDR=No;"";"
Set ADOCommand = New ADODB.Command
With ADOCommand
.ActiveConnection = Source
.CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
End With
Set Rst = New ADODB.Recordset
Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
Set Rst = Source.Execute("[" & Feuille & Cellule & "]")
Extraction = Rst(0).Value
Rst.Close
Source.Close
Set Source = Nothing
Set Rst = Nothing
Set ADOCommand = Nothing
End Function |
Répondre avec citation
)
Envoyé par Microsoft Visual Basic
Partager