Progressbar pendant l'envoi d'un mail

[David]

Bonjour à tous

J'ai trouvé se code pour une progresseBar :

Private Sub CommandButton1_Click()
ProgressBar1.Visible = True
 Sheets("base").Select
    Range("A1").Select
Dim c As Range
For Each c In Range("d6:d120")
ProgressBar1.Value = c.Row ' évolution de la progressbar
If c.Value = "" Then
    c.EntireRow.Hidden = True
End If
Next
Unload Me
End Sub

Apparement la ProgressBar dur le temps de Range("d6:d120"). Je voudrais calquer la durée sur l'envois d'un mail. J(utilise pour cela se code :

Sub Envoie_mail(destinataire)
On Erreur GoTo Erreur_envoie
    ActiveWindow.Close
Dim iConf As Object
Dim Flds
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
With Flds
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.orange.fr"
    .Update
End With
 
    Dim iMsg
    Set iMsg = CreateObject("CDO.Message")
 
With iMsg
    Set .Configuration = iConf
    .To = destinataire
    .From = "xxxxxxxxx@orange.fr"
    .Subject = "Calendrier des congés " & Nom_equipe
    .TextBody = "Bonjour" & Chr$(13) & Chr$(10) & "" & Chr$(13) & Chr$(10) & " Merci de nous retourner le fichier AU PLUS TARD le dernier jour d'arrètés des paies en cliquant sur le bouton 'RETOUR DU FICHIER'" & Chr$(13) & Chr$(10) & "" & Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10)
    .AddAttachment (ThisWorkbook.Path & "/" & Nom_equipe & ".xls")
     .Send
End With



Exit Sub
Erreur_envoie:
    MessageErreur3 = MsgBox("UNE ERREUR C'EST PRODUITE LORS DE L'ENVOI D'UN FICHIER", vbExclamation, "APPLICATION CONGES")
    End
End Sub

Comment faire pour que la ProgressBar dur le temps de .send ? Est ce possible.

J'essaie de faire un fichier, mais c'est très difficile vu le nombre de macro et la taille du fichier.

Merci