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.
Merci d'avance
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
Dernière édition: