Discussion :

[Belino]

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 :

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

[Belino]

Merci pour l'assisatnce à la mise en page de mon post.
J'ai repris maréflexion et un premier test me fait penser que le soucis vient du fait que je clique sur un "bouton" pour déclencher la fermeture : "thisworkbook.close"

J'ai la forte impression que le soucis est là : si je ferme via un clic sur la croix de la fenêtre ça a l'air de mieux fonctionner...

quelqu'un saurait expliciter ce mystère?

Bonne journée

[oOVaveOo]

Bonjour,
c'est qu'à priori, la commande thisworkbook.close ne déclenche pas l'événement Workbook_BeforeClose.

Tu peux toujours mettre la même macro dans une sub normale que tu appellerais avec le bouton avant de faire le thisworkbook.close.

[Belino]

Et pourtant lorsque je suis le déroulement de ma macro pas à pas, il passe bien dans beforeclose...
Merci oOVaveOo pour ce premier élément de réponse.

En enlevant mon bouton (qui provoque le thisworkbook.close) m macro fonctionne excellemment bien.
Le mystère perdure.