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

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

1hello.xlsm (23.64 Ko)
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
Rechercher des sujets similaires à "application quit impossible"