Plantage excel sur fermeture classeur

treza88

XLDnaute Occasionnel
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.

Pour info le code est dans le classeur que je ferme, mais je ne pense pas que ce soit un réelle probleme?

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


Code:
 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
 
Dernière édition:

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
312 084
Messages
2 085 194
Membres
102 814
dernier inscrit
JLGalley