beforeclose & sauvegarde de fichier
Bonjour à tous,
je me casse le cerveau depuis pas mal de temps sur une macro qui fonctionnait il y a encore peu et qui ne fonctionne donc plus. Je cherche donc de l'aide.
Le principe générique est qu'à la fermeture du fichier A, une série d'action est entreprise :
- copie de données et/ou masquer une ligne dans un fichier B,
- changement de nom du fichier A.
Aujourd'hui j'ai donc un double problème...
lors du déroulement de "beforeclose" qui globalement fonctionne, lorsque la macro se déroule, l'ordinateur semble considérer mon code, ne pas bloquer dessus(pas de message d'erreur) mais ne fait pas ce que je lui demande de faire (et ça c'est très énervant!)
enh outre, imposible de :
- supprimer les feuilles
- changer le nom "save as"
Est-ce que quelqu'un peut me sauver svp???
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
| Private Sub Workbook_BeforeClose(cancel As Boolean)
fin = Sheets("fiche").Cells(71, 2).Value
Set LL = ActiveWorkbook
If fin = 0 Then 'condition pour fermer
If Sheets("fiche").Cells(70, 2).Value = "Fiche" Then 'critère de reconnaissance qu'on traite bien une fiche et pas le catalogue
titre = Cells(8, 5).Value
If titre <> "" Then 'présence d'un titre = critère pour pouvoir fermer
réponse = MsgBox("Souhaitez-vous enregistrer les modifications apportées au fichier " & Chr(10) & titre & " ?", vbYesNoCancel)
If réponse = vbYes Then
Application.AlertBeforeOverwriting = False
Cells(5, 24).FormulaR1C1 = Date
If Cells(7, 20).Value = Cells(74, 2).Value Then
If Cells(6, 24).Value = "" Then Cells(6, 24).FormulaR1C1 = Date
Else
Cells(6, 24).FormulaR1C1 = ""
End If
'MsgBox ("fermeture")
o = 0
ir = 0
d = 0
c = 0
e = 0
'==> jusqu'ici tout va bien !
If Sheets.Count > 1 Then ' ici, il ne supprimer pas les feuilles
Application.DisplayAlerts = False
Sheets(4).Delete
Sheets(3).Delete
Sheets(1).Delete
Application.DisplayAlerts = True
End If
[...]
nom_de_sauvegarde = chemin_dossier & "\" & code & ".xls"
If nom_fichier <> code & ".xls" Then
'sauvegarder la fiche sous son nouveau nom codifié ' là il ne veut plus
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
nom_de_sauvegarde, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.DisplayAlerts = True
'supprimer l'ancien fichier
'Set fs = CreateObject("Scripting.FileSystemObject")
'Set fichier_à_supprimer = fs.getfile(chemin_dossier & "\" & nom_fichier)
'fichier_à_supprimer.Delete
Else
ActiveWorkbook.Save
End If
[...]
Else 'cas où il n'y a pas de titre
If ThisWorkbook.Name = "temporary.xls" Then 'traitement du cas où création d'un brouillon qu'on ne souhaite pas sauvegarder
'laisser une trace du numero de code pour libérer la place dans catalogue pour suppression ligne
ligne_insertion_prochain_code_libre = Workbooks("Lessons_learned.xls").Sheets("codes libres").Cells(2, 4).Value
Workbooks("Lessons_learned.xls").Sheets("codes libres").Cells(ligne_insertion_prochain_code_libre, 1).FormulaR1C1 = Workbooks("temporary.xls").Sheets("fiche").Cells(67, 19).Value
Workbooks("Lessons_learned.xls").Sheets("codes libres").Cells(2, 4).FormulaR1C1 = ligne_insertion_prochain_code_libre + 1
Workbooks("Lessons_learned.xls").Sheets("catalogue").Rows (Workbooks("temporary.xls").Sheets("fiche").Cells(67, 19).Value + 6 & ":" & Workbooks("temporary.xls").Sheets("fiche").Cells(67, 19).Value + 6)
Selection.EntireRow.Hidden = True ' là il ne veut pas non-plus
fin = 1
'Application.Run "Lessons_learned.xls!thisworkbook.procedure_suppression_temporary"
Else
[...]
End If 'fin du traitement spécial du cas où création d'un brouillon qu'on ne souhaite pas sauvegarder
End If 'fin du if condition présence d'un titre
End If 'fin du cas où c'est une fiche
Else 'si fin est différent de 0
End If 'fin de if fin = 0
Saved = True
End Sub |
