[XL-2007] Fermeture fichier excel [Résolu]

[catetesse]

Bonjour,

J'ai un fichier Excel que je souhaite fermer automatiquement si à un msgbox, présent dans ce fichier, on répond "oui".

Voici le code :

Code :

1
2
3
4
5
6
7
8
9
    rep5 = MsgBox("Avez vous un autre ordre d'affrètement à faire ?", vbYesNo + vbQuestion, "Nouvel ordre d'affrètement")
        If rep5 = 6 Then
            Range("e5").Select
        Else
            ActiveWorkbook.Close
        End If
 
 
End Sub

Mais Excel plante.

Est-il possible de fermer automatiquement le fichier où se trouve la macro ?

Merci

Catherine

[jfontaine]

Bonjour

Code :

Mais Excel plante.

Sur quelle ligne?

ici on sauvegarde a la fermeture sans message de confirmation

Code :

ActiveWorkbook.Close True

[patricktoulon]

bonjour catherine

Code :

1
2
3
4
5
6
7
8
9
10
11
sub fermeture
rep5 = MsgBox("Avez vous un autre ordre d'affrètement à faire ?", vbYesNo + vbQuestion, "Nouvel ordre d'affrètement")
        If rep5 = vbyes Then
            Range("e5").Select
        Else
       application.displayalerts=false 'ceci supprime la question que windows te pose quand tu ferme (fenêtre d'avertissement)   
 ActiveWorkbook.Close
        End If
 
 
End Sub

la fonction "application.displayalerts=false" te permet de te passer de répondre "êtes vous sur ect...."
au plaisir

[catetesse]

Bonjour à tous les deux,

En fait j'ai le même souci avec ce que vous avez proposé : c'est à dire qu'Excel se ferme bien mais ensuite j'ai le message "Microsoft Office Excel a rencontré un problème et doit être fermé. Nous vous prions de nous excuser pour le désagrément encouru"
Je clique sur "Ne pas envoyer le rapport" et Excel se relance automatiquement.

Est-ce que cela provient de la macro ?

merci

Catherine

[jfontaine]

Je ne pense pas que ce message soit lié à ta macro. (Du moins sur ce que l'on voir)
Je pencherais plus sur un problème de stabilité de l'application Excel sur ton poste

[patricktoulon]

rebonjour

moi pour savoir si c'est mon application ou le code qui est responsable du blocage de la fenetre qui je suppose devient toute blanche
je met un "end" en fin de macro se qui a pour but d'arrêter le code en cas de souci
donc si avec le " end" en fin de macro sa ne le fait plus alors il y a un souci dans ton code sinon
réinstalle ton office


au plaisir

[catetesse]

C'est bien ce que je craignais. Même avec le End ça plante.

Y a t-il moyen d'améliorer la stabilité d'Excel ?
Quand j'utilise le UserForm de mon fichier ça plante de temps en temps comme cela.

Merci

Catherine

[patricktoulon]

normalement si tu a réinstaller office ça ne devrait plus le faire

maintenant tu parle de userform
y a t il une boucle dans le code de l'userform qui ne s'arrêterait pas ?

ensuite a tu assez de mémoire sur ta bécane ?

des question il y en a bien d'autres
procède par élimination


au plaisir

[catetesse]

Effectivement le fichier Excel que je souhaite fermer comprend un User-form.

Je suis en entreprise, j'ai ce PC depuis peu. Je ne peux pas installer moi-même Office : je dois demander à un informaticien !

J'ai 35 Go d'espace libre sur le PC.

Merci pour ces informations.

Bonne fin de journée

Catherine

[patricktoulon]

rebonsoir

je comprend mieux

si certaines librairie sont absentes ou bloquées sur cette ordinateur pro

ca risque d'etre gènant

demande aux responsable informatique si les mises a jours sont bien faites

i compris les correctif surtout que a mon avis tu bosse sur xp


au plaisir

[catetesse]

Bonjour,

Je reviens sur mon soucis. Effectivement tous les PC fonctionnent sous XP.

Dans ma macro j'ouvre et je ferme un autre fichier et ça ne plante pas.
J'ai testé la macro sur un autre PC et ça plante également à la fermeture finale.

Est-ce normale que ça fonctionne une seule fois ?

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
Sub Validation_ordre()
'
' Copie les infos de l'ordre en ligne 40 pour les copier dans le fichier "liste globale des ordres"
'
    ActiveSheet.Unprotect
1   Range("B5").Copy
    Range("A40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F4").Copy
    Range("B40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B6:C6").Copy
    Range("C40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B10:C10").Copy
    Range("D40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B12:C12").Copy
    Range("E40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E12:F12").Copy
    Range("F40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G40").Select
 
    ActiveCell.FormulaR1C1 = "=MONTH(RC[-2])"
    Range("F8").Copy
    Range("H40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Range("I40").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(R[-26]C[-7],Listes!C[-7]:C[-6],2,FALSE)"
 
    Range("A14").Copy
    Range("J40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B14:D14").Copy
    Range("K40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E14:F14").Copy
    Range("L40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Range("A15:D15").Copy
    Range("M40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E15:F15").Copy
    Range("O40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
      Range("A16:D16").Copy
    Range("p40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E16:F16").Copy
    Range("r40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
        Range("A17:D17").Copy
    Range("s40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E17:F17").Copy
    Range("u40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Range("A18:D18").Copy
    Range("v40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E18:F18").Copy
    Range("x40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Range("A19:D19").Copy
    Range("y40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E19:F19").Copy
    Range("aa40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Range("A20:D20").Copy
    Range("ab40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E20:F20").Copy
    Range("ad40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Range("A21:D21").Copy
    Range("ae40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E21:F21").Copy
    Range("ag40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Range("A22:D22").Copy
    Range("ah40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E22:F22").Copy
    Range("aj40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Range("E24:F24").Copy
    Range("AK40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G23").Copy
    Range("AL40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H5:I5").Copy
    Range("AT40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
'Ouvre le fichier "liste globale des ordres" puis enregistre les données, sauvegarde et ferme le fichier
    Range("A40:AT40").Copy
    Workbooks.Open Filename:= _
        "\\Elcfr2\logistique\Ordres affrètements\Liste globale des ordres.xlsx"
    Sheets("Liste des ordres").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    Cells(ActiveCell.Row + 1, Column + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
'enregistre la formule pour le calcul de la taxe gasoil et du montant total
    Cells(ActiveCell.Row, Column + 41).Select
    ActiveCell.FormulaR1C1 = "=RC[-2]*RC[-1]"
    Cells(ActiveCell.Row, Column + 42).Select
    ActiveCell.FormulaR1C1 = "=RC[-3]+RC[-1]"
    Range("A1").Select
 
    ActiveWorkbook.Save
    ActiveWorkbook.Close
 
    Sheets("Ordre").Select
    Range("e5").Select
 
  '   imprime l'ordre d'affrètement
    rep6 = MsgBox("Voulez vous imprimer cet ordre ?", vbYesNo + vbQuestion, "Impression de l'ordre affrètement")
    If rep6 = 6 Then
        ActiveWindow.SelectedSheets.PrintOut Copies:=1
    Else
    End If
 
 
 '   Enregistre en pdf l'ordre d'affrètement dans le dossier logistique
 
    Chemin = "\\Elcfr2\logistique\Ordres affrètements\Ordres en PDF\"
    Texte = Range("nom_transporteur") & " - " & Range("num_ordre")
    Application.DisplayAlerts = False
 
    ActiveSheet.ExportAsFixedFormat Type:=x1TypePDF, _
    Filename:=Chemin & Texte, _
    Quality:=x1QualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
 
' Envoie l'ordre par e-mail si demandé
 
    rep1 = MsgBox("Faut-il envoyer l'ordre par e-mail ?", vbYesNo + vbQuestion, "Envoi de l'ordre d'affrètement par e-mail")
        If rep1 = 6 Then
            Dim Chem As String, Fich As String, Dest1 As String, Dest2 As String
            Dim oApp As Object, oMail As Object
            'Recherche fichier
            Sheets("Ordre").Select
            ActiveSheet.Unprotect
 
            With Sheets("Ordre")
                Chem = .Range("x4")
                Fich = .Range("x6") & ".pdf"
                Dest1 = .Range("j6")
                Dest2 = .Range("j7")
            End With
 
            Set oApp = CreateObject("Outlook.Application")
            Set oMail = oApp.CreateItem(0)
 
            With oMail
                .To = Dest1
                .CC = Dest2
                .BCC = ""
                .Subject = "Affrètement OMG"
                .HTMLBody = "Bonjour, vous trouverez ci-joint un nouvel ordre d'affrètement pour OM Group"
                .Attachments.Add (Chem & Fich)
               .Send
            End With
 
            Set oMail = Nothing
            Set oApp = Nothing
 
            Else
           End If
 
 
' Boucle spéciale pour ST Tours : changement de date et commentaires
    Range("a14").Select
    If ActiveCell = "ST Tours" Then
        rep2 = MsgBox("y a t-il une autre date pour ST Tours ?", vbYesNo + vbQuestion, "Ordre affrètement ST Tours")
            If rep2 = 6 Then
                rep3 = InputBox("Entrer la nouvelle date", titre)
                Range("b12") = rep3
                Range("e12") = rep3
                rep4 = MsgBox("Camion Deshayes ?", vbYesNo + vbQuestion, "Ordre affrètement ST Tours")
                 If rep4 = 6 Then
                   Range("e14") = "Camion Deshayes"
                   Else
                   Range("e14") = "Camion OMG"
                   End If
 
 
 
    'change la référence de l'ordre
            Range("M7").Select
            ActiveCell.FormulaR1C1 = "=MID(R[-2]C,7,2)"
            Range("M8").Select
            ActiveCell.FormulaR1C1 = "=R[-1]C+1"
            Range("M9").Select
            ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-5]C[-3],R[-8]C,""-"",R[-1]C)"
            Selection.Copy
            Range("M5").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
                GoTo 1
            Else
            End If
    Else
    End If
 
'   Efface la ligne 40 et lance la macro d'éffacement du formulaire
    Range("A40:AT40").ClearContents
    Application.Run "Efface_ordre"
 
 
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False
    ActiveWorkbook.Save
 
 
    rep5 = MsgBox("Avez vous un autre ordre d'affrètement à faire ?", vbYesNo + vbQuestion, "Nouvel ordre d'affrètement")
        If rep5 = vbYes Then
            Range("e5").Select
        Else
       Application.DisplayAlerts = False 
        ActiveWorkbook.Close True
        End If
 
End Sub

l'informaticien n'intervient que le jeudi !

Merci

Catherine

[jfontaine]

Quelques commentaires sur ton code

1 .

Code :

1
2
3
Range("B5").Copy
Range("A40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Il serait peut être plus simple d'écrire comme cela

Code :

Range("A40").Value = Range("B5").Value

2 .
Dans le code ci dessous tu copies les cellules B6 et C6 en C40 (donc B6 va en C40 et C6 en D40). Mais ensuite tu copies B10 et C10 en D40. Tu écrases la première copie . Dans ce cas vois si tu ne peux pas te reporter a ma proposition 1

Code :

1
2
3
4
5
6
    Range("B6:C6").Copy
    Range("C40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B10:C10").Copy
    Range("D40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

3. Quand tu manipule plusieurs classeur, je te conseillerais d'utiliser des variables Workbook plutôt que Activeworkbook

Code :

1
2
3
4
Dim Wrk as Workbook
set Wrk = Workbooks.Open Filename:= _
        "\\Elcfr2\logistique\Ordres affrètements\Liste globale des ordres.xlsx"
Wrk.Sheets("Liste des ordres").Select

Cela rend ton code beaucoup plus lisible


Pour le plantage, mets en place la gestion d'erreur pour voir si l'anomalie passe par cette gestion

Code :

1
2
3
4
5
6
7
Sub Validation_ordre()
On Error GoTo Gerreur
.... Code
Exit Sub
Gerreur:
msgbox err.Number & "-" & err.Descriptif
End Sub

[catetesse]

Bonjour jfontaine,

Merci pour ces conseils je vais les mettre en application dès que possible. J'ai appris sur le tas en prenant sûrement de mauvaises habitudes.

Concernant mon soucis avec Excel j'ai mis en place dans ma macro la gestion d'erreur.

Soit au début de ma macro

Code :

On Error GoTo Gerreur

et en fin de macro

Code :

1
2
3
Exit Sub
Gerreur:
MsgBox Err.Number & "-" & Err.Descriptif

la macro plante sans message d'erreur et le débogeur surligne en jaune "MsgBox Err.Number & "-" & Err.Descriptif"

Qu'est-ce que cela signifie ?
Merci

Catherine

[Jean-Pierre49]

Essais en correction du code de jérôme, que je salut

Code :

MsgBox Err.Number & "-" & Err.Description

Cordialement

[catetesse]

Jérôme et Jean-Pierre

Cette fois ci j'ai un code : "424 - objet requis"

Qu'est ce que cela signifie ?

Merci

Catherine

[Jean-Pierre49]

Enleve la gestion d'érreur et montre la ligne qui cause problème

[catetesse]

Jean-Pierre,

Une question idiote : comment je peux savoir quelle ligne pose problème ?
Dans VBA je n'ai pas de n° de ligne.

Merci

[Jean-Pierre49]

La ligne devrait être jaune
ça tilt, tu fait débogage et ta ligne sera jaune
tu dis

[catetesse]

En fait je n'ai pas besoin du débogeur.

Quand ça plante j'ai une fenêtre avec le titre "Microsoft Excel" qui s'ouvre avec l'info "424 - object requis" je clique sur la seule option possible OK et Excel reste ouvert ainsi que le fichier.

Je n'ai aucune ligne surlignée dans VBA !

Catherine

[Jean-Pierre49]

Supprime la gestion d'érreur que tu as placé

Code :

On Error GoTo Gerreur

mets un ' devant pour qu'elle devienne verte

Tu dis