[XL-2010] Passage d'Excel 2003 à 2010

Passage d'Excel 2003 à 2010

Bonjour,

Je suis passé de 2003 à 2010 et mon programme ne fonctionne plus j'ai l'erreur d'exécution '-2147024809 (80070057) et ma macro m indique ci-dessous une erreur .Shapes("Button 7").Delete.

Pouvez-vous m'aider ?

Code:

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
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
Sub Envoi_par_mail()
 
'Working in 97-2010
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim Destinataire As Variant
    Dim Titre As String
    Dim I As Long
    Dim Ladate As String
    Dim Chemin As String
 
 
 
    If ActiveSheet.Name = "Feuille de saisie" Then
        Titre = "Eval office " & Cells(8, 4)
        Ladate = Format(Cells(7, 4), "dd-mmm-yyyy")
        Chemin = Worksheets("Perso").Cells(3, 7).Value
    End If
 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
 
    Set Sourcewb = ActiveWorkbook
 
    'Copy the sheet to a new workbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook
 
    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2010, we exit the sub when your answer is
            'NO in the security dialog that you only see  when you copy
            'an sheet from a xlsm file with macro's disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "Your answer is NO in the security dialog"
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With
 
    If Destwb.Sheets(1).Name = "Feuille de saisie" Then
        With Destwb.Sheets(1)
            .Shapes("Button 4").Delete
            .Shapes("Button 5").Delete
            .Shapes("Button 6").Delete
            .Shapes("Button 7").Delete
            .Shapes("Button 8").Delete
            '.Shapes("Picture 3").Delete
            '.Shapes("Picture 11").Delete
            '.Shapes("Button 10").Delete
            '.Shapes("WordArt 9").Delete
        End With
    End If
 
    'Change all cells in the worksheet to values if you want
    With Destwb.Sheets(1).UsedRange
        .Cells.Copy
        .Cells.PasteSpecial xlPasteValues
        .Cells(1).Select
    End With
 
    Application.CutCopyMode = False
 
    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = Titre & " " & Ladate
 
 
    Destwb.SaveCopyAs (Chemin & Titre & " " & Ladate & ".xls")
 
 
    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        For I = 1 To 3
            .SendMail Destinataire, "Evaluation office"
            If Err.Number = 0 Then Exit For
        Next I
        On Error GoTo 0
        .Close SaveChanges:=False
    End With
 
    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr
 
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
 
    If ActiveSheet.Name = "Feuille de saisie" Then
        Enregistrer_saisie
    End If
 
End Sub
 
Sub Envoi_par_mail_trimestre()
 
'Working in 97-2010
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim Destinataire As Variant
    Dim Titre As String
    Dim I As Long
    Dim Ladate As String
    Dim Chemin As String
 
    Titre = "Eval trimestrielles offices GCL "
    Ladate = Format(Now, "dd-mmm-yyyy")
 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
 
    Set Sourcewb = ActiveWorkbook
 
    'Copy the sheet to a new workbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook
 
    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2010, we exit the sub when your answer is
            'NO in the security dialog that you only see  when you copy
            'an sheet from a xlsm file with macro's disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "Your answer is NO in the security dialog"
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With
 
    Destwb.Sheets(1).Shapes("Button 3").Delete
 
    'Change all cells in the worksheet to values if you want
    With Destwb.Sheets(1).UsedRange
        .Cells.Copy
        .Cells.PasteSpecial xlPasteValues
        .Cells(1).Select
    End With
 
    Application.CutCopyMode = False
 
    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Eval trimestrielles offices GCL " & Ladate
 
 
    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        For I = 1 To 3
            .SendMail Destinataire, "Eval trimestrielles offices GCL "
            If Err.Number = 0 Then Exit For
        Next I
        On Error GoTo 0
        .Close SaveChanges:=False
    End With
 
    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr
 
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
 
End Sub
 
Sub Envoi_par_mail_formaction()
 
'Working in 97-2010
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim Destinataire As Variant
    Dim Titre As String
    Dim I As Long
    Dim Ladate As String
    Dim Chemin As String
 
    Titre = "Formations Hygiène Officières GCL "
    Ladate = Format(Now, "dd-mmm-yyyy")
 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
 
    Set Sourcewb = ActiveWorkbook
 
    'Copy the sheet to a new workbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook
 
    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2010, we exit the sub when your answer is
            'NO in the security dialog that you only see  when you copy
            'an sheet from a xlsm file with macro's disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "Your answer is NO in the security dialog"
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With
 
    Destwb.Sheets(1).Shapes("Button 4").Delete
 
    'Change all cells in the worksheet to values if you want
    With Destwb.Sheets(1).UsedRange
        .Cells.Copy
        .Cells.PasteSpecial xlPasteValues
        .Cells(1).Select
    End With
 
    Application.CutCopyMode = False
 
    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Formations Hygiène Officières GCL " & Ladate
 
 
    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        For I = 1 To 3
            .SendMail Destinataire, "Formations Hygiène Officières GCL "
            If Err.Number = 0 Then Exit For
        Next I
        On Error GoTo 0
        .Close SaveChanges:=False
    End With
 
    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr
 
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
 
End Sub

Bonjour JC7.7,

La méthode Shape.Delete est toujours présente dans Excel 2010.
Je soupçonne donc une histoire de changement de nom des boutons.

Si l'objectif est de supprimer l'ensemble des boutons, il est peut-être préférable de faire quelque chose comme ceci :
Code:

1 2 3 For Each img In Worksheets(1).Shapes 'ou Worksheets("nom").Shapes img.Delete Next
Dans le cas où toutes les Shapes ne doivent pas être supprimées, peut-être faut-il rajouter une condition sur leur nom par exemple.

Voila ce que j'avancerai.
N'hésite pas à me tenir au courant. :ccool:

Cordialement,
Kimy

excel 2003 à 2010

Bonjour Kimy,

Merci avant tout de ta célérité concernant ta réponse, j'ai essayé de rajouter tes 3 lignes et j'ai comme message.

Erreur de compilation : variable non définie

Je n'ai pas du mettre ce rajout ou il fallait. Merci de ta réponse si tu peux m'aider

Bien à toi

JC

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
If Destwb.Sheets(1).Name = "Feuille de saisie" Then
        With Destwb.Sheets(1)
            .Shapes("Button 4").Delete
            .Shapes("Button 5").Delete
            .Shapes("Button 6").Delete
            .Shapes("Button 7").Delete
            .Shapes("Button 8").Delete
            '.Shapes("Picture 3").Delete
            '.Shapes("Picture 11").Delete
            '.Shapes("Button 10").Delete
            '.Shapes("WordArt 9").Delete
    For Each img In Worksheets(1).Shapes 'ou Worksheets("nom").Shapes
    img.Delete
    Next

Bonjour JC7.7,

Non. En effet ! :mrgreen:
L'idée de mon bout de code est de supprimer toutes les images/shapes sans passer par leur nom ! ;)

Ainsi :
Code:

1 2 3 4 5 6 7 If Destwb.Sheets(1).Name = "Feuille de saisie" Then With Destwb.Sheets(1) For Each img In .Shapes 'ou Worksheets("nom").Shapes img.Delete Next img End With End If
:ccool:

Cordialement,
Kimy

Bonjour,

Tu peux déjà contrôler le nom de tes Shapes avec le code ci-dessous dans le cas où tu ne souhaiterais pas les supprimer tous mais qu'une partie d'entre eux. Leurs noms est inscrit dans la fenêtre d'exécution (Ctrl+G) :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Sub NomShapes() Dim S As Shape For Each S In ActiveSheet.Shapes Debug.Print S.Name Next S End Sub
Hervé.