Barre de progression

Bonjour le forum ;

Voilà j'ai une barre de progression sur ma macro dispatch mais parfois elle arrive à 100% et la macro est toujours en cours d'exécution je voudrais quelle fonction simultanément ou comme un compteur pour voir que la macro est toujours en cours

Besoin d'aide , Merci a vous d'avance .

Bonjour,

le problème vient de ce que le compteur est decorrélé de l'indicateur d'avancement réel !

      ' à customiser ==================================
    BarreProgression.Caption = "Veuillez patienter..."

    For compteur = 0 To 100 Step 2
        BarreDeProgression compteur / 100
        Application.Wait (Now + TimeValue("0:00:01"))
    Next
    ' ===============================================

Il faut remplacer

Application.Wait (Now + TimeValue("0:00:01"))

qui est une instruction factice par la macro. Ou bien intégrer

BarreDeProgression compteur / 100

dans ta boucle principale

Essaie ceci ...

Option Explicit

Dim fa As Worksheet, f As Worksheet, fm As Worksheet, tablo
Dim i&, derLn&, timedebut, compteur

Sub Dispatcher()

 timedebut = Now()

    Application.ScreenUpdating = False
    BarreProgression.Show vbModeless
    BarreProgression.Caption = "Veuillez patienter..."

    Set fa = Feuil1
    Set fm = Sheets("Modèle")
    Application.ScreenUpdating = False

    tablo = fa.Range("A1:M" & fa.Range("A" & Rows.Count).End(xlUp).Row)

    For i = 6 To UBound(tablo, 1)

        BarreDeProgression (i / UBound(tablo, 1))

        On Error Resume Next
        Set f = Sheets(CStr(tablo(i, 3)))
        If Err.Number <> 0 Then
            fm.Visible = True
            fm.Copy after:=fa
            ActiveSheet.Name = CStr(tablo(i, 3))
            Set f = ActiveSheet
        End If
        derLn = f.Range("A" & Rows.Count).End(xlUp)(2).Row
        fa.Range("A" & i & ":M" & i).Copy f.Range("A" & derLn)
        f.Range("A" & derLn) = derLn - 5

    Next i
    fm.Visible = False

    i = 0
    For Each f In Worksheets

        i = i + 1
        BarreDeProgression (i / Worksheets.Count)

            If f.Name <> "Feuil1" And f.Name <> "Modèle" Then
            derLn = f.Range("A" & Rows.Count).End(xlUp)(2).Row
            f.Range("K" & derLn & ":M" & derLn).FormulaR1C1 = "=SUM(R[" & -derLn + 6 & "]C:R[-1]C)"

        End If
    Next f

    Unload BarreProgression
End Sub

Bonjour ,

Parfait , un grand merci a toi Steelson