Application.Quit impossible alors qu'avant oui ?
Bonjour à tous en ce beau jour d'automne
J'ai épuré mon fichier avant de le poster qui est en fait un fichier de pointage à envoyer à la personne concernée toutes les fins de semaines, avec des options de fin avant fermeture et sauvegarde.
En gros, après tout ce qu'il y a à faire je sauvegarde et ferme sois le classeur, soir le classeur et l'application (à noter que lorsque je règle [H9] à "OUI", [H8] se règle automatiquement à "OUI" pour être cohérent.
![image](https://forum.excel-pratique.com/file/img/1/18773_6542212a1dff2594730470.png)
Je quitte bien le classeur, mais pas moyen de quitter l'appli Excel alors que ça fonctionnait très bien avant!
Serait ce dû au passage récemment à Office 2021 ?
Merci par avance pour votre aide sans faille
Sub hello()
ActiveWorkbook.Save
If Sheets("Données").[H8] = "OUI" Then
ActiveWorkbook.Close
End If
If Sheets("Données").[H9] = "OUI" Then
Application.Quit
End If
End Sub
Bonjour dasaquit
C'est juste une question de logique
Il faut tester "quitter" avec fermeture
Sub hello()
ActiveWorkbook.Save
If Sheets("Données").[H9] = "OUI" Then
Application.Quit
ElseIf Sheets("Données").[H8] = "OUI" Then
ActiveWorkbook.Close
End If
End Sub
A+
Pfouuuu ça parait tellement simple après la soluce !
J'ai été logique dans la chronologie cases 8 & 9 mais pas dans celle Excel
Un grand MERCI Bruno t'es super
Un très bon jour férié............... à geeker (C'est une vrai drogue ce machin)
David
Re,
Bon ben ça fonctionnait nickel sur mon fichier test, mais toujours pas sur mon fichier source lorsque je transpose ; c'est rageant
Je fais alors comme dans le cinquième élément : "Heeeeeellllllllp"
Mon code source ci dessous
A toute....
Sub Envoyer_Mail_Outlook_Pdf_Données()
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Destinataires As String
Dim Copie As String
Dim Sujet As String
Dim Text As String
If Sheets("Données").[B32] = 0 Then
MsgBox "Vous devez renseigner au moins une adresse mail dans l'onglet Donnée", , "Désolé"
End If
If Sheets("Données").[B32] >= 1 Then
'---------------------------------------------------------
Set ObjOutlook = New Outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)
Destinataires = Range("Données!B10").Value
Copie = Range("Données!B11").Value & ";" & Range("Données!B12").Value & ";" & Range("Données!B13").Value
Sujet = Range("Données!B3").Value & " " & Range("Données!B7").Value & " " & Range("Données!B8").Value
Text1 = Range("Données!B4").Value
Text2 = Range("Données!B5").Value
Text3 = Range("Données!B6").Value
Text4 = Range("Données!B7").Value 'Signature
'---------------------------------------------------------
ActiveSheet.ExportAsFixedFormat Type:=xlTypexslm, Filename:= _
ActiveWorkbook.Path & "\" & "Pointage hebdo " & Range("Données!B7") & " " & Range("Données!B8") & "." & "Pdf"
'---------------------------------------------------------
With oBjMail
.To = Destinataires
.CC = Copie
.Subject = Sujet
.Body = Text1 & vbCrLf & vbCrLf & Text2 & vbCrLf & Text3 & vbCrLf & vbCrLf & Text4
.Attachments.Add ActiveWorkbook.Path & "\" & "Pointage hebdo " & Range("Données!B7") & " " & Range("Données!B8") & "." & "Pdf"
If Sheets("Données").[H3] = "OUI" Then
.ReadReceiptRequested = True
End If
If Sheets("Données").[H4] = "OUI" Then
.Send
MsgBox "Votre pointage a été envoyé. " & vbNewLine & Chr(13) & "A bientôt !", , "Développé par D, pour" & " " & Range("Données!B14")
End If
If Sheets("Données").[H5] = "OUI" Then
.Display
MsgBox "Votre pointage se trouve en attente dans Outlook, et est prêt à être envoyé. " & vbNewLine & Chr(13) & "A bientôt !", , "Développé par D, pour" & " " & Range("Données!B14")
End If
End With
'---------------------------------------------------------
Kill ActiveWorkbook.Path & "\" & "Pointage hebdo " & Range("Données!B7") & " " & Range("Données!B8") & "." & "Pdf"
'---------------------------------------------------------
If Sheets("Données").[H6] = "OUI" Then
Application.Wait Now + TimeSerial(0, 0, 2)
ObjOutlook.Quit
End If
Set oBjMail = Nothing
Set ObjOutlook = Nothing
'---------------------------------------------------------
'MsgBox "Votre pointage a été envoyé. " & vbNewLine & Chr(13) & "A bientôt !", , "Développé par D, pour" & " " & Range("Données!B14")
'---------------------------------------------------------
If Sheets("Données").[H7] = "OUI" Then
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
ActiveWorkbook.Save
If Sheets("Données").[H9] = "OUI" Then
Application.Quit
ElseIf Sheets("Données").[H8] = "OUI" Then
ActiveWorkbook.Close
End If
End Sub