Sub Quitter()
If Workbooks.Count = 1 Then
ThisWorkbook.Save
Application.Quit
Else
ThisWorkbook.Close saveschanges = True
End If
End Sub
Sub Macro1()
For I = 1 To Workbooks.Count
MsgBox Workbooks(I).Name
Next I
End Sub
Sub Macro1()
If Workbooks.Count = 2 Then
ThisWorkbook.Close True
Application.Quit
Else
ThisWorkbook.Close True
End If
End Sub
Sub Macro1()
If Workbooks.Count = 1 Then
ThisWorkbook.Close True
Application.Quit
Else
ThisWorkbook.Close True
End If
End Sub
OK . Mais il se trouve que mon classeur doit s'ouvrir sur d'autres postes .Certains on le fichier de macros perso et d'autres pas.Bonjour KTM, bonjour le forum,
L'instruction Workbooks.Count permet de savoir combien de classeurs sont ouverts. Toutefois, tu peux, si tu utilises le fichier des macro personnelles PERSONAL.XLSB avoir 2 classeurs ouverts. Sauf que le classeur des macros personnelles est caché.
Donc il faut que tu vérifies avant si tu utilises un classeur des macro personnelles avec le code :
VB:Sub Macro1() For I = 1 To Workbooks.Count MsgBox Workbooks(I).Name Next I End Sub
Selon le cas le code sera
• avec le fichier des macros personnelles :
• sans le fichier des macros personnelles :VB:Sub Macro1() If Workbooks.Count = 2 Then ThisWorkbook.Close True Application.Quit Else ThisWorkbook.Close True End If End Sub
VB:Sub Macro1() If Workbooks.Count = 1 Then ThisWorkbook.Close True Application.Quit Else ThisWorkbook.Close True End If End Sub
Sub Macro1()
Dim CL As Workbook
Dim TEST As Boolean
For Each CL In Workbooks
If UCase(Right(CL.Name)) = "XLSB" Then TEST = True
End If
Select Case TEST
Case True
If Workbooks.Count = 2 Then
ThisWorkbook.Close True
Application.Quit
Else
ThisWorkbook.Close True
End If
Case False
If Workbooks.Count = 1 Then
ThisWorkbook.Close True
Application.Quit
Else
ThisWorkbook.Close True
End If
End Select
End Sub
Sub Fermer()
If Not ThisWorkbook.Saved Then ThisWorkbook.Save
If Workbooks.Count = 1 Then Application.Quit Else ThisWorkbook.Close
End Sub
Merci CHEF ; ça marche mais Excel reste encore ouvert parce que j'ai un fichier de macros personnelles sur mon PC que faireBonjour KTM, Robert,
A mon avis ceci suffit bien :
S'il y a des fichiers dont les fenêtres sont masquées Excel restera ouvert, un point c'est tout.Code:Sub Fermer() If Not ThisWorkbook.Saved Then ThisWorkbook.Save If Workbooks.Count = 1 Then Application.Quit Else ThisWorkbook.Close End Sub
A+
J'ai essayé mais une erreur survient à ce niveau : If UCase(Right(CL.Name)) = "XLSB" Then TEST = TrueRe,
Peut-être comme ça mais je ne garantis rien... :
VB:Sub Macro1() Dim CL As Workbook Dim TEST As Boolean For Each CL In Workbooks If UCase(Right(CL.Name)) = "XLSB" Then TEST = True End If Select Case TEST Case True If Workbooks.Count = 2 Then ThisWorkbook.Close True Application.Quit Else ThisWorkbook.Close True End If Case False If Workbooks.Count = 1 Then ThisWorkbook.Close True Application.Quit Else ThisWorkbook.Close True End If End Select End Sub
Remarque : il faut pas nous le fâcher notre Job ! Après il devient colère et c'est tout le site qui en pâtit... Empathie...
On s'en fiche, si vous n'êtes pas handicapé des 2 mains vous aurez à cliquer ensuite sur la croix, un point c'est tout.Merci CHEF ; ça marche mais Excel reste encore ouvert parce que j'ai un fichier de macros personnelles sur mon PC que faire
Bonjour à tousMerci CHEF ; ça marche mais Excel reste encore ouvert parce que j'ai un fichier de macros personnelles sur mon PC que faire
Sub quitter()
Dim i&, Nombre&
For i = 1 To Workbooks.Count
If UCase(Workbooks(i).Name) = "PERSONAL.XLSB" Then Nombre = Workbooks.Count - 1: Exit For
Next
With ThisWorkbook
If Nombre = 1 Then
.Save
Application.Quit
Else
.Close True
End If
End With
End Sub
Sub Fermer()
Dim wb As Workbook, win As Window
If Not ThisWorkbook.Saved Then ThisWorkbook.Save
For Each wb In Workbooks
If wb.Name <> ThisWorkbook.Name Then
If wb.Saved Then
For Each win In wb.Windows
If win.Visible Then ThisWorkbook.Close 'ferme le fichier
Next win
Else
ThisWorkbook.Close 'ferme le fichier
End If
End If
Next wb
Application.Quit 'ferme Excel
End Sub
Sub Ferme_Et_Sauve_Juste_ce_Fichier()
'Ferme excel si seul ce fichier est ouvert
Dim w As Window
For Each w In Windows
If w.Caption = ThisWorkbook.Name Then GoTo suite
'Workbooks(w.Caption).Close True
suite:
Next w
ThisWorkbook.Save
If Workbooks.Count = 1 Then Application.EnableEvents = False: Application.Quit
ThisWorkbook.Close
End Sub
Sub Ferme_Tout_ET_Sauve()
Dim w As Window
For Each w In Windows
If w.Caption = ThisWorkbook.Name Then GoTo suite
Workbooks(w.Caption).Close True
suite:
Next w
ThisWorkbook.Save
Application.EnableEvents = False
Application.Quit
End Sub
Sub Ferme_Tout_Rend_Visible_Et_Sauve()
Dim w As Window
For Each w In Windows
If w.Visible = False Then w.Visible = True
If w.Caption = ThisWorkbook.Name Then GoTo suite
Workbooks(w.Caption).Close True
suite:
Next w
ThisWorkbook.Save
Application.EnableEvents = False
Application.Quit
End Sub
Sub Ferme_Tout_Sans_Sauver()
Dim w As Window
For Each w In Windows
If w.Caption = ThisWorkbook.Name Then GoTo suite
Workbooks(w.Caption).Close False
suite:
Next w
ThisWorkbook.Close 0
End Sub
MERCI pour toutBonjour à tous
Comme je m'étais trompé de discussion (Merci Job75 ), faut dire que les 2 avatars se ressemblaient, je remet le code.
Suivant ce que je veux faire j'utilise un de ces codes:
VB:Sub Ferme_Et_Sauve_Juste_ce_Fichier() 'Ferme excel si seul ce fichier est ouvert Dim w As Window For Each w In Windows If w.Caption = ThisWorkbook.Name Then GoTo suite 'Workbooks(w.Caption).Close True suite: Next w ThisWorkbook.Save If Workbooks.Count = 1 Then Application.EnableEvents = False: Application.Quit ThisWorkbook.Close End Sub Sub Ferme_Tout_ET_Sauve() Dim w As Window For Each w In Windows If w.Caption = ThisWorkbook.Name Then GoTo suite Workbooks(w.Caption).Close True suite: Next w ThisWorkbook.Save Application.EnableEvents = False Application.Quit End Sub Sub Ferme_Tout_Rend_Visible_Et_Sauve() Dim w As Window For Each w In Windows If w.Visible = False Then w.Visible = True If w.Caption = ThisWorkbook.Name Then GoTo suite Workbooks(w.Caption).Close True suite: Next w ThisWorkbook.Save Application.EnableEvents = False Application.Quit End Sub Sub Ferme_Tout_Sans_Sauver() Dim w As Window For Each w In Windows If w.Caption = ThisWorkbook.Name Then GoTo suite Workbooks(w.Caption).Close False suite: Next w ThisWorkbook.Close 0 End Sub