ウィンドウズ上のアプリケーションでは時間のかかる処理が
行われるような場合、処理経過状況を知るにはプログレスバー
と呼ばれるものが使われることがあります。エクセル固有の機能
でプログレスバーを実現する場合、ステータスバーに”■”を
いくつも表示させる、ユーザフォームを表示して、ラベルの長さ
を調節する、などの方法が考えられますが、ここではワークシート
上でShapeを使ってプログレスバーを実現する方法を考えます。

（機能）
１．３つのShapeを描画（ProgressBarの土台、色つき、色なし）
２．１で描画した色なしのShapeのWidthを調節して処理の進捗状況を表現
３．処理の終了とShapeの削除

（サンプル）※上記機能を3つのプロシージャとして個別に実現します

'------標準モジュール------
Option Explicit
Private TargetSh As Worksheet
Private TotalValue As Long, PrevValue As Long
Private MyShape As Shape, MyShape2 As Shape, BaseShape As Shape
Private Const W As Double = 280, H As Double = 20


Public Sub BeginProgress(Total As Long, _　　
                         Sh As Worksheet, _
                         X  As Long, _
                         Y  As Long)
    '１の機能

    Set TargetSh = Sh　'モジュールレベルで用意した変数に表示対象のシートを設定
    TotalValue = Total　'モジュールレベルで用意した変数に最大値を格納

　　'Shapeの描画
    Set BaseShape = Sh.Shapes.AddShape(msoShapeRectangle, _
                X, Y, W + 20, H + 10)
    Set MyShape = Sh.Shapes.AddShape(msoShapeRectangle, _
                X + 10, Y + 5, W, H)
    Set MyShape2 = Sh.Shapes.AddShape(msoShapeRectangle, _
                X + 10, Y + 5, W, H)
                
    With MyShape　'色つきShapeの設定
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = vbRed
        .Fill.Patterned msoPatternLightVertical
        .Line.Visible = msoFalse
    End With

    MyShape2.Line.Visible = msoFalse　'色なしShapeの設定
    BaseShape.Line.Weight = 5　'土台となるShapeの枠線の太さを指定
    PrevValue = 1'前回値を１とする

End Sub

Public Sub CountUp(Cur As Long)　　'２の機能

    Dim i As Long
    If Cur < PrevValue Then Exit Sub
    For i = PrevValue To Cur
        MyShape2.Width = W - (W / TotalValue * i)
        DoEvents
    Next i
    PrevValue = Cur'前回値を設定

End Sub

Public Sub EndProgress()　　'３の機能

    Call CountUp(TotalValue) 'Totalまで進める

　　'削除
    TargetSh.Shapes.Range(Array _
        (BaseShape.Name, MyShape.Name, MyShape2.Name)) _
        .Delete
    Set TargetSh = Nothing

End Sub

'---テスト用プロシージャ---シート上のコマンドボタンより

Private Sub CommandButton1_Click()

    Dim i As Long

    '最大値、対象シート、X座標、Y座標を指定してShapeを描画
    Call BeginProgress(250, ActiveSheet, 200, 200)

    '処理開始　-　セルへの値書き込み
    For i = 1 To 250
        ActiveSheet.Cells(i, 1).Value = i
        '現在値を与えて進捗情況を表示
　　    Call CountUp(i)
    Next i

    'プログレスバーを最大値まで進めて削除
    Call EndProgress

End Sub

※使い方

BeginProgress（最大値、対象シート、X座標、Y座標）
CountUp（現在値）
EndProgress

上記サンプルは単純なループ構造で収まらない場合を想定して、
最大値と現在値を指定できるようにしましたが、CountUpプロシ
ージャでは必ずしも最大値まで進捗させる必要はありません。
ProgressBarの進捗が途中でも、処理が終わった時点で
EndProgressを呼び出せば、強制的に最大値まで進めた上でShape
を削除します。