Tout mon code ne s'exécute pas ..

**guigui77** · 01/05/2014, 18h54

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

**parmi** · 01/05/2014, 19h20

Peux-tu expliquer ce qui ne fonctionne pas ?
Est-ce que ça cause une erreur ?
Si oui, donne le numéro et la description de cette erreur ainsi que la ligne exacte où ça se produit.

Ceci dit, je ne pense pas la nécessité de Application.Run dans la macro Main()
Utilise seulement le nom des macros que tu veux appeler.
Tu peux aussi, si tu préfères, utiliser Call devant ces noms de macros

ex:
MaMacro
ou
Call MaMacro

**Marc-L** · 01/05/2014, 19h39

Bonjour,

en aparté, qu'apporte la ligne n°54 vis à vis de la n°53 tout comme la ligne n°47 comparativement à la n°46,
à part de ralentir le processus ?!

**guigui77** · 01/05/2014, 19h52

Bonjour,
ça n'apporte rien! D'ailleurs je les avait déja supprimé de mon code. POur ce qui est du message d'erreur je ne me souviens plus exactement n'étant au bureau pour vérifier. Sinon que moi je travailles qu’essentiellement sur SAS et c'est pour la première fois je m’essaie à du VBA.

En ma macro s'exécute jusqu'à rename_affaire. A ce stade, j'ai deux fichier excel ouvert qui s'appel recap_affaire et recap_os . Mon objectif, c'est de transformer ces noms en recap_affaire28042014 et recap_os28042014 si la date est bien sur le 28042014. D'ou l'écriture des macros nom1 et nom2 qui sont:

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
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

Avez vous une proposition plus simple pour moi?

Merci d'avance les amis

**parmi** · 01/05/2014, 20h49

Le problème vient peut-être du fait que ActiveWorkbook n'est pas vraiment celui que tu penses au moment d'appeler ces macros.
Est-ce possible ?
ActiveWorkbook est celui qui est affiché à l'écran.
ThisWorkbook est celui qui contient la macro qui roule.

**guigui77** · 01/05/2014, 20h58

En gros je t'explque le problème.Avant d'ecrire la macro nom1, j'ai deux feuilles de noms: recap_affaire et recap_os. La feuille active (celui sur lequel le curseur est ) est recap_affaire. Donc je voudrais que excel me renomme la feuille recap_affaire en recap_affaire28042014(recap_affaire et date du jour quoi) puis après il va sur la feuille recap_os puis le nomme recap_os28042014 (recap_os et date du jour) .C'est ce que j'ai éssayé de faire. Je peux te confirmer que avant la macro nom1 la feuille active est recap_affaire. J'espere etre clair.
Merci

**parmi** · 02/05/2014, 14h21

J'ai de la difficulté à suivre...
Tu parles de renommer des feuilles, mais le code renomme des classeurs

Fichier = "recap_affaire" & Format(Date, "ddmmyyyy") & ".xls"
ActiveWorkbook.SaveCopyAs Chemin & Fichier

Pour renommer les feuilles:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveSheet.Name = "Le nom à donner"

Si tu veux sauvegarder la feuille seule, utilises

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Activesheet.Copy
Activeworkbook.SaveAs "Le nom du fichier"

Changer ActiveSheet pour le nom de la feuille au besoin.

Tout mon code ne s'exécute pas ..

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager