Barre de progression sous Excel

Bonjour à tous,

Je fonctionne sous Windows XP SP3 et Excel 2003. J'ai créé un classeur dans lequel, par macro, je sauvegarde, à un instant donné, une des feuilles dans un nouveau classeur. Selon l'importance de cette feuille cela prends +/- de tps. Je souhaiterais afficher une barre de progression pendant le déroulement de cette macro. J'ai cherché ici même et j'ai trouvé l'exemple ci-dessous :

Sub demo()
    Dim i As Double
    barreProgression action:="CREER"
    For i = 0 To 100 Step 0.5
        DoEvents
        barreProgression action:="METTRE_A_JOUR", pourcentage:=i
    Next
    barreProgression action:="SUPPRIMER"
End Sub
 
Sub barreProgression(ByVal action As String, Optional pourcentage As Double)
    Dim s As Shape
    Dim pc As Double
    Dim couleur As Long
    Static large As Integer
' Paramètres
    Const HAUTEUR_BARRE = 10        ' hauteur de la barre de progression en points
    Const LARGEUR_INFO = 30            ' largeur de la barre de progression en points
    Const MARGE = 20                           ' largeur de la marge latérale en points
    Const MARGE_INFERIEURE = 40    ' hauteur de la marge inférieure en points
    Const TAILLE_CARACTERE = 8       ' taille de la police de caractères  
    couleur = RGB(128, 128, 128)           ' couleur de la zone variable de la barre de progression
    Select Case action
        Case "CREER"
            Dim bas As Integer
            large = ActiveWindow.UsableWidth - 2 * MARGE - LARGEUR_INFO
            bas = ActiveWindow.UsableHeight - MARGE_INFERIEURE
            For Each s In ActiveSheet.Shapes
                If Left(s.Name, 6) = "progb_" Then s.Delete
            Next
            ActiveSheet.Shapes.AddShape(msoShapeRectangle, MARGE, bas, large, HAUTEUR_BARRE).Select
            Selection.Name = "progb_cadre"
            ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, large + MARGE - LARGEUR_INFO, bas, _
                LARGEUR_INFO, HAUTEUR_BARRE).Select
            Selection.Name = "progb_info"
            Selection.Characters.Font.Size = TAILLE_CARACTERE
            Selection.HorizontalAlignment = xlCenter
            ActiveSheet.Shapes.AddShape(msoShapeRectangle, MARGE, bas, 0, HAUTEUR_BARRE).Select
            With Selection
                .ShapeRange.Fill.ForeColor.RGB = couleur
                .ShapeRange.Line.Visible = msoFalse
                .Name = "progb_curseur"
            End With
        Case "SUPPRIMER"
            For Each s In ActiveSheet.Shapes
                If Left(s.Name, 6) = "progb_" Then s.Delete
            Next
        Case "METTRE_A_JOUR"
            pc = IIf(Abs(pourcentage) > 100, 100, Abs(pourcentage))
            ActiveSheet.Shapes("progb_curseur").Width = (large - LARGEUR_INFO) * pourcentage / 100
            ActiveSheet.Shapes("progb_info").TextFrame.Characters.Text = Fix(pc) & "%"
        Case Else
            MsgBox "Le parametre action est invalide"
    End Select
End Sub

Je l'ai testé et cela me convient parfaitement. Cette macro fonctionne sur une boucle avec une progression de la barre à chaque itération. Moi ce que j'ai souhaiterais c'est quelle démarre au début de ma macro et qu'elle s'arrête à la fin et je n'arrive pas à l'intégrer à ma macro.
Pouvez-vous m'aider.
D'avance merci
Mistral