Barre de Progression sur Macro VBA plusieurs Appels Macro Call

Bonjour j'ai une macro d'actualisation des données. il y a plusieurs actualisations de données qui sont appelées dans une macro Actualisation.

Je souhaite faire un UserForm ou barre de progression qui permette d'afficher à l'utilisateur qu'il doit patienter.

Voici mon Code vba pour l'ctualisation des données :

Sub Rafraichir_DATA()

    Choix_Reponse_Actualisation_DATAS = MsgBox("Vous allez actualiser les données pour le périmètre : " & ActiveSheet.Name & chr(13) & chr(10) & "Souhaitez-vous actualiser les données ?", vbYesNo + vbInformation + vbDefaultButton2, "Actualisation des Données")

    If Choix_Reponse_Actualisation_DATAS = vbYes Then

        'ActiveSheet.ProtectContents = False

        Application.ScreenUpdating = False

        Dim Date_Actualisation_Terminee, Time As Date
        Date_Actualisation = Now
        Feuille_Active = ActiveSheet.Name
        DerniereLigne_Avant_Rafraichissement = Range("B" & Rows.Count).End(xlUp).Row

        Call Suppression_Bouton_Case_A_Cocher

        Call Affichage_Heure_et_User_pour_DATA_Actualisee

        Call Suppression_DATAS

        Call Supprime_Mise_En_Forme_Conditionnelle_Feuille

        Call Parametres_Pour_Rafraichissement_DATAS

        Call Recuperer_Donnees_Operations_Suspens

        'Si Erreur lors de l'Actualisation des Données
        'Exemple Problème Réseau, Internet, Pas Traitement Macro
        If Connexion_Etablie = False Then
            Exit Sub
        End If

        Call Creation_Titre_Et_Mise_En_Forme_Tableau

        Application.Wait (Now + TimeValue("00:00:05"))

        Call Creation_Bouton_Case_A_Cocher

        Call Filtre_Suppression_Operation_Ref_Client_YMIDL

        Call Trier_DTH_Plus_Ancien_Au_Plus_Recent

        Call Creation_SSI_CACEIS

        Call Extraction_Adresses_Emails

        Call Mise_En_Forme_Conditionnelle

        'Call Reduire_Ascensseur

        Call Figer_Cellules

        Call Remettre_Cellule_Reference_Globe_Sans_Fond_Apres_Actualisation
        'Call Commentaires_au_Survol_Souris_sur_ref_Globe_Apres_Actualisation_Operations_Relancees

        ActiveWorkbook.Save

        Sheets(Feuille_Active).Range("B4").Activate

        Date_Actualisation_Terminee = Now
        Time = Date_Actualisation_Terminee - Date_Actualisation

        Fin_Actualisation_DATAS = MsgBox("Actualisation des opérations en suspens pour le périmètre d'activité " & Feuille_Active & " terminée." & chr(13) & chr(10) & "Temps d'actualisation : " & Time, vbInformation, "Fin d'Actualisation des Données")

    ElseIf Choix_Reponse_Actualisation_DATAS = vbNo Then

        Choix_Actualisation_Donnees_Annulee = MsgBox("Données Suspens non actualisées." & chr(13) & chr(10) & "Pensez à actualiser régulièrement afin de suivre l'activité.", vbInformation, "Données Suspens Non Actualisées")

    End If

    'ActiveSheet.ProtectContents = True

    Application.ScreenUpdating = True

End Sub

J'ai créé un Userform pour la barre de progression :

Sub Afficher()

    Me.Show 0

End Sub

Sub Actualiser(taux As Integer)

   barre.Width = Barre_Texte.Width * taux / 100
   Barre_Texte = taux & "%"

   If taux = 100 Then Unload Me

   DoEvents

End Sub

Mais je ne sais pas comment l'appeler dans ma macro de Rafraichissement de données. A savoir que les temps d'execution des differentes macro ne sont pas les mêmes.

Merci pour votre aide :)

Bonjour,

D'abord un ajustement :

Sub Actualiser(taux As Integer)

    barre.Width = Barre_Texte.Width * taux / 100
    Barre_Texte = taux & "%"
    DoEvents
    Application.Wait (Now + TimeValue("0:00:01"))

   If taux = 100 Then Unload Me

End Sub

Ensuite, vous devez répartir votre taux par rapport à l'exécution de vos procédures au nombre de 15. Avec une répartition linéaire, on arrive à une moyenne de 7%. Evidemment, vous pouvez ajuster votre répartition en fonction du temps d'exécution de vos procédures.

En supposant que votre UserForm de progression s'appelle "Barre_progression", ci dessous exemple de code avec répartition linéaire :

Sub Rafraichir_DATA()

    Choix_Reponse_Actualisation_DATAS = MsgBox("Vous allez actualiser les données pour le périmètre : " & ActiveSheet.Name & Chr(13) & Chr(10) & "Souhaitez-vous actualiser les données ?", vbYesNo + vbInformation + vbDefaultButton2, "Actualisation des Données")

    If Choix_Reponse_Actualisation_DATAS = vbYes Then

        'ActiveSheet.ProtectContents = False

        Application.ScreenUpdating = False

        Dim Date_Actualisation_Terminee, Time As Date
        Date_Actualisation = Now
        Feuille_Active = ActiveSheet.Name
        DerniereLigne_Avant_Rafraichissement = Range("B" & Rows.Count).End(xlUp).Row

        With Barre_progression
            taux = 0:  .Afficher: .Actualiser(taux)

            Call Suppression_Bouton_Case_A_Cocher
            taux = taux + 7: .Actualiser(taux)

            Call Affichage_Heure_et_User_pour_DATA_Actualisee
            taux = taux + 7: .Actualiser(taux)

            Call Suppression_DATAS
            taux = taux + 7: .Actualiser(taux)

            Call Supprime_Mise_En_Forme_Conditionnelle_Feuille
            taux = taux + 7: .Actualiser(taux)

            Call Parametres_Pour_Rafraichissement_DATAS
            taux = taux + 7: .Actualiser(taux)

            Call Recuperer_Donnees_Operations_Suspens
            taux = taux + 7: .Actualiser(taux)

            'Si Erreur lors de l'Actualisation des Données
            'Exemple Problème Réseau, Internet, Pas Traitement Macro
            If Connexion_Etablie = False Then
                Exit Sub
            End If

            Call Creation_Titre_Et_Mise_En_Forme_Tableau
            taux = taux + 7: .Actualiser(taux)

            Application.Wait (Now + TimeValue("00:00:05"))

            Call Creation_Bouton_Case_A_Cocher
            taux = taux + 7: .Actualiser(taux)

            Call Filtre_Suppression_Operation_Ref_Client_YMIDL
            taux = taux + 7: .Actualiser(taux)

            Call Trier_DTH_Plus_Ancien_Au_Plus_Recent
            taux = taux + 7: .Actualiser(taux)

            Call Creation_SSI_CACEIS
            taux = taux + 7: .Actualiser(taux)

            Call Extraction_Adresses_Emails
            taux = taux + 7: .Actualiser(taux)

            Call Mise_En_Forme_Conditionnelle
            taux = taux + 7: .Actualiser(taux)

            'Call Reduire_Ascensseur

            Call Figer_Cellules
            taux = taux + 7: .Actualiser(taux)

            Call Remettre_Cellule_Reference_Globe_Sans_Fond_Apres_Actualisation
        'Call Commentaires_au_Survol_Souris_sur_ref_Globe_Apres_Actualisation_Operations_Relancees
            taux = 100: .Actualiser(taux)

        End With

Bonjour merci pour ces explications. Je vais tester là.

Ces 3 macros prennent le plus de temps d'execution. Je dirai la premiere 70% du temps d'execution total et les 2 autres 15% chacune. Comment adapter ?

Call Recuperer_Donnees_Operations_Suspens
Call Creation_SSI_CACEIS
Call Extraction_Adresses_Emails

Merci

Je viens de tester. Ca marche très bien. Merci :):) !!!