Microsoft 365 Animation en attente de résultat

Private Const SND_APPLICATION = &H80 ' look for application specific association
Private Const SND_ALIAS = &H10000 ' name is a WIN.INI [sounds] entry
Private Const SND_ALIAS_ID = &H110000 ' name is a WIN.INI [sounds] entry identifier
Private Const SND_ASYNC = &H1 ' play asynchronously
Private Const SND_FILENAME = &H20000 ' name is a file name
Private Const SND_LOOP = &H8 ' loop the sound until next sndPlaySound
Private Const SND_MEMORY = &H4 ' lpszSoundName points to a memory file
Private Const SND_NODEFAULT = &H2 ' silence not default, if sound not found
Private Const SND_NOSTOP = &H10 ' don't stop any currently playing sound
Private Const SND_NOWAIT = &H2000 ' don't wait if the driver is busy
Private Const SND_PURGE = &H40 ' purge non-static events for task
Private Const SND_RESOURCE = &H40004 ' name is a resource name or atom
Private Const SND_SYNC = &H0 ' play synchronously (default)
Private Declare PtrSafe Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" _
    (ByVal lpszName As String, ByVal hModule As LongPtr, ByVal dwFlags As Long) As Long

Sub Jouer_Click()
    PlaySound "G:\MOSAIQUE\son_1.wav", ByVal 0&, SND_FILENAME Or SND_ASYNC
End Sub

Sub Arreter_Click()
    PlaySound 0&, ByVal 0&, SND_FILENAME Or SND_ASYNC
End Sub

Private Const SND_ASYNC = &H1           ' play asynchronously
Private Const SND_FILENAME = &H20000    ' name is a file name

Private Declare PtrSafe Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" _
    (ByVal lpszName As String, ByVal hModule As LongPtr, ByVal dwFlags As Long) As Long

'---------------------
'Jouer un fichier .wav
'---------------------
Sub JouerWav(FileFullName As String)
    Call PlaySound(FileFullName, ByVal 0&, SND_FILENAME Or SND_ASYNC)
End Sub

Function waitProcess() As Object
    Dim IE
    Set IE = CreateObject("internetexplorer.application")
    With IE
        .Visible = True
        .StatusBar = False
        .Toolbar = False
        .Width = 200: .Height = 100
        .navigate "about:blank"
        Do While .readystate < 4: DoEvents: Loop
        With .document
            .Title = "procedure en cours"
            .write "<marquee> Veuillez patienter pendant la procédure</marquee>"
        End With

    End With
    Set waitProcess = IE
End Function

Sub test()
    Set x = waitProcess
    For i = 1 To 800000000
    Next
    x.Quit
End Sub