Microsoft 365 Fermer Word depuis Excel

Sub ActivationWord2()
Dim Wapp As Object, doc As Object
On Error Resume Next 'si Word n'est pas ouvert
Set Wapp = GetObject(, "Word.Application")
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
Wapp.Activate
'---"
Application.Wait Now + 5 / 86400 'attente 5 secondes pour tester
For Each doc In Wapp.documents: doc.Saved = True: Next 'pas d'enregistrement demandé
Wapp.Quit 'ferme Word
End Sub

Sub Test3()
Dim Wsh As Object, Reponse As Integer
Set Wsh = CreateObject("WScript.Shell")


duree = Range("A2") ' Durée entre 2 itérations
' Sécurité si l'utilisateur programme un temps trop court entre 2 itérations
If duree < 3 Then
    MsgBox ("Durée min 3 secondes")
    Exit Sub
End If

Range("A14") = 0
NbDeCycle = 0

Do Until Condition
Reponse = Wsh.popup("Voulez vous sortir ?", duree, "Confirmation", vbYesNo + vbDefaultButton2)

Select Case Reponse
    Case -1                 'Pas de réponse => toutes les 5 itérations ouvre Word
        'pas de réponse
        NbDeCycle = NbDeCycle + 1
        Range("A14") = NbDeCycle

        'Ouverture de word si multiple de 5
        If NbDeCycle Mod 5 = 0 Then
            Dim Wapp As Object, doc As Object
            On Error Resume Next 'si Word n'est pas ouvert
            Set Wapp = GetObject(, "Word.Application")
            If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
            Wapp.Visible = True
            Wapp.Activate
              ' ____________
              With Wapp
                .Documents.Add
                With .ActiveDocument
                  With .ActiveWindow.Selection
                    .TypeText "Test fonctionnement sur Word" & vbLf & vbLf
                    .TypeText "Ligne 2" & vbLf
                    .TypeText "Ligne 3" & vbLf
                    .TypeText "Ligne 4" & vbLf
                    .TypeText "Ligne 5" & vbLf
                  End With
                End With
                .Visible = -1: .Activate
              End With
              ' ____________
            '---"
            Application.Wait Now + 5 / 86400 'attente 5 secondes pour tester
            For Each doc In Wapp.Documents: doc.Saved = True: Next 'pas d'enregistrement demandé
            Wapp.Quit 'ferme Word
        'MsgBox ("Test. Nb de cycles " & NbDeCycle)
        End If
          
    Case 6                  'Réponse oui
        Exit Sub ' pour l'instant
    
    Case 7                  'Réponse Non
        Exit Sub ' pour l'instant

End Select

Loop
End Sub