Plantage excel sur fermeture classeur

**zoumzoum59** · 15/11/2011, 09h15

Bonjour,

Dans une procedure qui me permet de quitter l'application si un seul classeur est ouvert ou de quitter uniquement le classeur ouvert si plusieur classeurs sont present, quant le classeur est tous seul pas de soucis ça ferme bien l'application par contre quant il y a plusieur classeurs d'ouvert, ça ferme bien le classeur concerné, mais juste apres ça fait planter excel avec proposition de recuperer les classeur fermer inopinemant.

Voici ma procedure car je ne vois pas ce qui produit le phenomene.

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
 
Sub recup_données()
    Dim Wb As Workbook
    ActiveSheet.Unprotect
    var = "G"
    var1 = "E4"
    var2 = "feuil1!E"
 
    Set Plage = Range("E4:E64")
    For Each Cel In Plage
        Ligne = Cel.Row
        Colonne = Cel.Column
        If Cel.Value <> Cells(Ligne - 1, Colonne).Value And Cel.Value <> Empty Or Cel.Offset(0, 1).Value <> Cells(Ligne - 1, Colonne + 1).Value And Cel.Offset(0, 1).Value <> Empty Then
            CelAL = Ligne
            CelAC = Colonne
            Call click_Bouton
        End If
 
    Next Cel
    Range("E4:G64").ClearContents
    ActiveWorkbook.Worksheets("feuil1").Select
    Dim MaDate, Mois, Année
    MaDate = Date           ' Attribue une date.
    Mois = Month(MaDate)    ' Mois contient le mois effectif.
    Mois = jour2    'MonthName(Mois)
    Année = Year(Date)
    NomFich = "Données du mois de " & Mois & " " & Année & ".xls"
    ChemFich = "Z:\Données temps fab\" & NomFich
    On Error GoTo Saut
    Dim wbk As Workbook
    Set wbk = Workbooks.Open(ChemFich)
 
    Do While wbk.ReadOnly = True
        MsgBox "This file is Read Only"
        wbk.Close
        Set wbk = Workbooks.Open(ChemFich)
    Loop
 
    Call Export
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Dim a As String
    a = MsgBox("Les données on été enregistrées." & vbCrLf & vbLf & "Voulez vous faire une autre saisie ?", vbYesNo, "Dernier choix avant de quitter")
    If a = vbNo Then
        For Each Wb In Application.Workbooks
            Wb.Saved = True
        Next Wb
        Dim NbClass As Integer
        NbClass = Application.Workbooks.Count
        If NbClass > 1 Then
            ActiveWorkbook.Close SaveChanges:=False
            Else
            Application.Quit
        End If
    End If
 
    Exit Sub
Saut:
    Dim NewBook
    Set NewBook = Workbooks.Add
    NewBook.SaveAs filename:=ChemFich
    ActiveCell.Value = "Date"
    ActiveCell.Offset(0, 1).Value = "Client"
    ActiveCell.Offset(0, 2).Value = "Poste"
    ActiveCell.Offset(0, 3).Value = "Temps passé"
    ActiveCell.Offset(0, 4).Value = "Saisie"
    Call Export
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    a = MsgBox("Voulez vous faire une autre saisie ?", vbYesNo, "AM Création")
    If a = vbNo Then
        For Each Wb In Application.Workbooks
            Wb.Saved = True
        Next Wb
        Dim NbClass2 As Integer
        NbClass2 = Application.Workbooks.Count
        If NbClass2 > 1 Then
            ActiveWorkbook.Close SaveChanges:=False
        Else
            Application.Quit
        End If
    End If
End Sub

Merci d'avance

**Daniel.C** · 15/11/2011, 11h19

J'ai juste testé à partir de la ligne 48 et Excel (2010) ne plante pas.

**carden752** · 15/11/2011, 11h30

Bonjour,

Je te vois ouvrir d'autres classeurs wbk mais jamais les refermer sauf peut-être dans la procédure export et réinitialiser wbk.

Code :

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

1
2
3
4
5
6
7
8
9
10
 Dim wbk As Workbook
    Set wbk = Workbooks.Open(ChemFich)
 
    Do While wbk.ReadOnly = True
        MsgBox "This file is Read Only"
        wbk.Close
        Set wbk = Workbooks.Open(ChemFich)
    Loop
 
    Call Export

Autre possibilité : Es-tu sur de ne pas refermer le classeur principal (celui qui contient ce code) avant tous les autres.

**zoumzoum59** · 15/11/2011, 11h42

Oui carden752, je referme bien le classeur qui contient le code, mais comment je peux faire pour que ça ne plante pas, car je ne peux pas le fermer par le biais d'un autre classeur.

Et je ne pensais pas que cela pouvait faire planter excel.

**Didier Gonard** · 15/11/2011, 12h05

Bonjour,

Dans un premier temps, tu instancies des variables objet à partir de ton classeur source et tu le fermes sans libérer tes variables, les objets étant toujours présents, au mieux, ce n'est pas propre, au pire...

cordialement,

Didier

**zoumzoum59** · 18/11/2011, 09h53

Voila Ormonth j'ai essayer de liberer mes variables wb wbk et Newbook en esperant que ce que j'ai fait est correct.

Mais pas de changement excel plante toujours, j'ai remis la procedure modifier, je mets egalement la procedure export, au cas quelqu'un voudrais avoir une idée de ce qu'il y a dedans.

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
 
Sub recup_données()
    Dim Wb As Workbook
    ActiveSheet.Unprotect
    var = "G"
    var1 = "E4"
    var2 = "feuil1!E"
 
    Set Plage = Range("E4:E64")
    For Each Cel In Plage
        Ligne = Cel.Row
        Colonne = Cel.Column
        If Cel.Value <> Cells(Ligne - 1, Colonne).Value And Cel.Value <> Empty Or Cel.Offset(0, 1).Value <> Cells(Ligne - 1, Colonne + 1).Value And Cel.Offset(0, 1).Value <> Empty Then
            CelAL = Ligne
            CelAC = Colonne
            Call click_Bouton
        End If
 
    Next Cel
    Range("E4:G64").ClearContents
    ActiveWorkbook.Worksheets("feuil1").Select
    Dim MaDate, Mois, Année
    MaDate = Date           ' Attribue une date.
    Mois = Month(MaDate)    ' Mois contient le mois effectif.
    Mois = jour2    'MonthName(Mois)
    Année = Year(Date)
    NomFich = "Données du mois de " & Mois & " " & Année & ".xls"
    ChemFich = "Z:\Données temps fab\" & NomFich
    On Error GoTo Saut
    Dim wbk As Workbook
    Set wbk = Workbooks.Open(ChemFich)
 
    Do While wbk.ReadOnly = True
        MsgBox "This file is Read Only"
        wbk.Close
        Set wbk = Workbooks.Open(ChemFich)
    Loop
    Set wbk = Nothing
    Call Export
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Dim a As String
    a = MsgBox("Les données on été enregistrées." & vbCrLf & vbLf & "Voulez vous faire une autre saisie ?", vbYesNo, "Dernier choix avant de quitter")
    If a = vbNo Then
        For Each Wb In Application.Workbooks
            Wb.Saved = True
        Next Wb
        Set Wb = Nothing
        Dim NbClass As Integer
        NbClass = Application.Workbooks.Count
        If NbClass > 1 Then
            ActiveWorkbook.Close SaveChanges:=False
            Exit Sub
        Else
            Application.Quit
        End If
    End If
 
    Exit Sub
Saut:
    Dim NewBook
    Set NewBook = Workbooks.Add
    NewBook.SaveAs filename:=ChemFich
    ActiveCell.Value = "Date"
    ActiveCell.Offset(0, 1).Value = "Client"
    ActiveCell.Offset(0, 2).Value = "Poste"
    ActiveCell.Offset(0, 3).Value = "Temps passé"
    ActiveCell.Offset(0, 4).Value = "Saisie"
    Set NewBook = Nothing
    Call Export
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    a = MsgBox("Voulez vous faire une autre saisie ?", vbYesNo, "AM Création")
    If a = vbNo Then
        For Each Wb In Application.Workbooks
            Wb.Saved = True
        Next Wb
        Set Wb = Nothing
        Dim NbClass2 As Integer
        NbClass2 = Application.Workbooks.Count
        If NbClass2 > 1 Then
            ActiveWorkbook.Close SaveChanges:=False
        Else
            Application.Quit
        End If
    End If
End Sub

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 Export()
 
    Workbooks("Saisie Activité Journalière.xls").Sheets("Feuil3").Visible = True
    Workbooks(NomFich).Activate
    ActiveWorkbook.Worksheets("feuil1").Select
    Range("A65536").End(xlUp).Offset(1, 0).Select
    Workbooks("Saisie Activité Journalière.xls").Activate
    ActiveWorkbook.Worksheets("feuil3").Select
    Range("A2").CurrentRegion.Select
    Selection.Cut
    Workbooks(NomFich).Activate
    ActiveWorkbook.Worksheets("feuil1").Select
    ActiveSheet.Paste
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Workbooks("Saisie Activité Journalière.xls").Sheets("Feuil3").Visible = False
 
End Sub

Dite moi si deja ce que j'ai fait et mieux ou pas.

Re

je viens de faire d'autres essaies et ça ne viendrai peut etre pas du fichier que je ferme mais peut etre plutot du fichier restant ouvert qui se reactive, car avec d'autre classeurs ouvert (essai fait avec des classeur ayant ou pas des macro) je n'ais pas de probleme excel ne bug pas. Dans le classeur qui reste ouvert et qui poserais probleme, j'ai la procedure suivante qui me permet d'afficher une barre d'outil perso a l'activation du classeur.

Code :

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

1
2
3
4
5
6
7
8
9
 Private Sub Workbook_Activate()
    On Error Resume Next
    If Application.CommandBars("BO").Visible = False Then
        Application.CommandBars("BO").Visible = True
    End If
    If Application.CommandBars("BO").Visible = False Then
        Call BO
    End If
End Sub

Et en continuant mes test, j'ai donc un message d'erreur qui se produit à la reactivation du classeur qui était rester ouvert.
Le message se produit juste à la reactivation,là ou j'ai mis un premier stop juste apres le debut de ma procedure, comme ci dessous :

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
Private Sub Workbook_Activate()
Stop
    On Error Resume Next
 
    If Application.CommandBars("BO").Visible = False Then
 
        Application.CommandBars("BO").Visible = True
 
    End If
    Stop
    If Application.CommandBars("BO").Visible = False Then
    Stop
        Call BO
            End If
End Sub

Erreur d'entrée/sortie de peripherique
Le tout dans une fenetre venant de Microsoft Visual Basic.

Pouvez vous me dire à quoi cela peut correspondre ?

Ensuite la procedure continu et excel plante entre le deuxieme et le troisieme stop.

Voyez vous une solution pour resoudre le probleme?

Merci d'avance

**zoumzoum59** · 25/11/2011, 09h13

Bonjour a tous

Pour info, j'ai resolution le probleme en mettant le code d'enregistrement du fichier dans une procedure independante comme ci dessous, et plus de plantage.

Quelqu'un pourra peut etre m'expliquer pourquoi ça fonctionne, car moi j'en sais rien mais ça marche.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Dim a As String
    a = MsgBox("Les données on été enregistrées." & vbCrLf & vbLf & "Voulez vous faire une autre saisie ?", vbYesNo, "Dernier choix avant de quitter")
    If a = vbNo Then
        For Each Wb In Application.Workbooks
            Wb.Saved = True
        Next Wb
        Set Wb = Nothing
 
Call Ferme_Classeur
 
    End If
 
    Exit Sub

Et

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Sub Ferme_Classeur()
Dim NbClass As Integer
        NbClass = Application.Workbooks.Count
        If NbClass > 1 Then
 
            ThisWorkbook.Close savechanges:=False
            Exit Sub
        Else
            Application.Quit
        End If
     Exit Sub
End Sub

Bonne journée a tous et merci

Plantage excel sur fermeture classeur [XL-2002]

Macros et VBA Excel

Discussions similaires

Partager

Partager