Bonjour,
Mon problème est le suivant. Mon programme s'exécute jusqu'à rename_affaire mais les macro nom1 et nom2 ne s'exécute pas. En effet mon but est de nommer les deux feuilles ouverts avec la date d'extraction des données puis les fermé. Mais les macros nom1 et nom2 ne marchen pas. Pour ce qui est du reste je mettre résolu des que j'aurai des idées un peu plus clair. Merci infiement d'avance

Le code est le suivant:


Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
Option Explicit
 
Private Declare Function URLDownloadToFile _
    Lib "urlmon" Alias "URLDownloadToFileA" _
    (ByVal pCaller As Long, ByVal szURL As String, _
    ByVal szFileName As String, ByVal dwReserved As Long, _
    ByVal lpfnCB As Long) As Long
 
Private Const ERROR_SUCCESS As Long = 0
 
Public Function DownloadFile(ByVal sURL As String, _
    ByVal sLocalFile As String) As Boolean
 
    Dim lngRetVal As Long
    DownloadFile = URLDownloadToFile(0&, sURL, _
        sLocalFile, 0&, 0&) = ERROR_SUCCESS
End Function
 
Sub telecharger_zip()
 
'------------------------fichier pour les affaires -------------------
 
    DownloadFile _
        "http://osr-distributeur.grdf.fr/docs/osr_hebdo/OSR_AFFAIRES_4_Nord-Pas_de_Calais.xlsx.zip", "Q:\TEMP\affaire_os\affaire\04_npdc_affaire.zip"
    DownloadFile _
        "http://osr-distributeur.grdf.fr/docs/osr_hebdo/OSR_AFFAIRES_5_Normandie.xlsx.zip", "Q:\TEMP\affaire_os\affaire\05_normadie_affaire.zip"
    DownloadFile _
        "http://osr-distributeur.grdf.fr/docs/osr_hebdo/OSR_AFFAIRES_6_Picardie.xlsx.zip", "Q:\TEMP\affaire_os\affaire\06_picardie_affaire.zip"
 
 
'------------------------fichier pour les OS -------------------
 
    DownloadFile _
        "http://osr-distributeur.grdf.fr/docs/osr_hebdo/OSR_OS_4_Nord-Pas_de_Calais.xlsx.zip", "Q:\TEMP\affaire_os\os\04_npdc_os.zip"
    DownloadFile _
        "http://osr-distributeur.grdf.fr/docs/osr_hebdo/OSR_OS_5_Normandie.xlsx.zip", "Q:\TEMP\affaire_os\os\05_normadie_os.zip"
    DownloadFile _
        "http://osr-distributeur.grdf.fr/docs/osr_hebdo/OSR_OS_6_Picardie.xlsx.zip", "Q:\TEMP\affaire_os\os\06_picardie_os.zip"
End Sub
 
'------------------------dezip des affaires -------------------
 
 
Sub dezip()
 
    Call UnZip("Q:\TEMP\affaire_os\affaire", "dezip", "Q:\TEMP\affaire_os\affaire\04_npdc_affaire.zip")
    Call UnZip("Q:\TEMP\affaire_os\affaire", "dezip", "Q:\TEMP\affaire_os\affaire\04_npdc_affaire.zip")
    Call UnZip("Q:\TEMP\affaire_os\affaire", "dezip", "Q:\TEMP\affaire_os\affaire\05_normadie_affaire.zip")
    Call UnZip("Q:\TEMP\affaire_os\affaire", "dezip", "Q:\TEMP\affaire_os\affaire\06_picardie_affaire.zip")
 
'------------------------dezip des OS -------------------
 
    Call UnZip("Q:\TEMP\affaire_os\os", "dezip", "Q:\TEMP\affaire_os\os\04_npdc_os.zip")
    Call UnZip("Q:\TEMP\affaire_os\os", "dezip", "Q:\TEMP\affaire_os\os\04_npdc_os.zip")
    Call UnZip("Q:\TEMP\affaire_os\os", "dezip", "Q:\TEMP\affaire_os\os\05_normadie_os.zip")
    Call UnZip("Q:\TEMP\affaire_os\os", "dezip", "Q:\TEMP\affaire_os\os\06_picardie_os.zip")
 
End Sub
 
Sub UnZip(strTargetPath As String, Dossier As String, Fname As Variant)
    Dim oApp As Object
    Dim FileNameFolder As Variant
    If Right(strTargetPath, 1) <> Application.PathSeparator Then
        strTargetPath = strTargetPath & Application.PathSeparator
    End If
    If Not (RepertoireExiste(strTargetPath & Dossier)) Then
        MkDir (strTargetPath & Dossier)
    Else
    FileNameFolder = strTargetPath & Dossier
    Set oApp = CreateObject("Shell.Application")
    oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
    End If
End Sub
 
Function RepertoireExiste(Chemin As String) As Boolean
On Error Resume Next
RepertoireExiste = GetAttr(Chemin) And vbDirectory
End Function
 
 
' Cette macro à pour but de nomme la premiere feuille le numéro de la semaine
 
Sub feuille_date()
Dim NumSem As Byte
NumSem = DatePart("ww", Date, 2, 2)
Sheets(1).Name = "Semaine_" & NumSem
End Sub
 
 
' Enregistrement de la feuille sous récap afin d'effectuer nos concatenations
 
Sub Macro_enregistrement()
 
 ChDir "Q:\TEMP\affaire_os\affaire\dezip"
    ActiveWorkbook.SaveAs Filename:= _
        "Q:\TEMP\affaire_os\affaire\dezip\Recap.xls", FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
 
  ChDir "Q:\TEMP\affaire_os\os\dezip"
    ActiveWorkbook.SaveAs Filename:= _
        "Q:\TEMP\affaire_os\os\dezip\Recap.xls", FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
 
End Sub
 
 
' La compilation
 
Sub Compilation()
Dim Temp As String
Dim Ligne As Long
Temp = Dir(ActiveWorkbook.Path & "\*.xls")
Application.DisplayAlerts = False
Do While Temp <> ""
If Temp <> "Recap.xls" Then
Workbooks.Open ActiveWorkbook.Path & "\" & Temp
Workbooks(Temp).Sheets(1).Range("A1").CurrentRegion.Copy
Workbooks("Recap.xls").Sheets(1).Activate
Ligne = Sheets(1).Range("A65536").End(xlUp).Row + 1
Range("A" & CStr(Ligne)).Select
ActiveSheet.Paste
Workbooks(Temp).Close
End If
Temp = Dir
Loop
Range("A1").Select
Application.DisplayAlerts = True
End Sub
 
Sub compil_os()
 
 ChDir "Q:\TEMP\affaire_os\os\dezip"
    ActiveWorkbook.SaveAs Filename:= _
        "Q:\TEMP\affaire_os\os\dezip\recap_os.xls", FileFormat:=xlExcel8, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
 
End Sub
 
 
' Ouverture recap affaire
 
Sub ouverture_recap_affaire()
    ChDir "Q:\TEMP\affaire_os\affaire\dezip"
    Workbooks.Open Filename:="Q:\TEMP\affaire_os\affaire\dezip\Recap.xls"
End Sub
 
Sub Compilation2()
Dim Temp As String
Dim Ligne As Long
Temp = Dir(ActiveWorkbook.Path & "\*.xls")
Application.DisplayAlerts = False
Do While Temp <> ""
If Temp <> "Recap.xls" Then
Workbooks.Open ActiveWorkbook.Path & "\" & Temp
Workbooks(Temp).Sheets(1).Range("A1").CurrentRegion.Copy
Workbooks("Recap.xls").Sheets(1).Activate
Ligne = Sheets(1).Range("A65536").End(xlUp).Row + 1
Range("A" & CStr(Ligne)).Select
ActiveSheet.Paste
Workbooks(Temp).Close
End If
Temp = Dir
Loop
Range("A1").Select
Application.DisplayAlerts = True
End Sub
 
Sub rename_affaire()
 
 ChDir "Q:\TEMP\affaire_os\affaire\dezip"
    ActiveWorkbook.SaveAs Filename:= _
        "Q:\TEMP\affaire_os\affaire\dezip\recap_affaire.xls", FileFormat:=xlExcel8, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
 
End Sub
 
Sub nom1()
Dim Chemin As String, Fichier As String
Chemin = "Q:\TEMP\affaire_os\affaire\dezip\"
'Ajoute la date du jour et l'heure dans le nom du fichier
Fichier = "recap_affaire" & Format(Date, "ddmmyyyy") & ".xls"
ActiveWorkbook.SaveCopyAs Chemin & Fichier
End Sub
 
 
Sub nom2()
Dim Chemin2 As String, Fichier2 As String
Chemin2 = "Q:\TEMP\affaire_os\os\dezip\"
'Ajoute la date du jour et l'heure dans le nom du fichier
Workbooks("recap_os.xls").Activate
Fichier2 = "recap_os" & Format(Date, "ddmmyyyy") & ".xls"
ActiveWorkbook.SaveCopyAs Chemin2 & Fichier2
Application.DisplayAlerts = False
Application.Quit
End Sub
 
Sub main()
Application.Run ("telecharger_zip")
Application.Run ("dezip")
Application.Run ("feuille_date")
Application.Run ("Macro_enregistrement")
Application.Run ("Compilation")
Application.Run ("compil_os")
Application.Run ("ouverture_recap_affaire")
Application.Run ("Compilation2")
Application.Run ("rename_affaire")
Application.Run ("nom1")
Application.Run ("nom2")
End Sub