サンプルと言っても、、、別のフォームを開いて、元のフォームを見せなくしたり、使用不能にするなどの処置をするだけだと思うのですが・・・
もしくはラベルを内部に持ったピクチャボックスをフォーム内に隠し持ち、EXCEL操作時にピクチャボックスを表示させるのも手だと思います。
んで・・・サンプルは全く別ですが・・・
私個人が使用しているオリジナルのプログレスバーがありますので、そちらを載せておきますね。
結構このクラスファイルは、使いまわしができると思います。
サンプルプロジェクト構成
Project1
┣Form1(フォーム)
┃┣Command1(コマンドボタン)
┃┣Command2(コマンドボタン)
┃┗Picture1(ピクチャボックス)
┗Class1(クラスファイル)
----Form1----
Option Explicit
Dim objBar1 As Class1
Private Sub Command1_Click()
With objBar1
'値を増加させる
If .Value < .Max Then
.Value = .Value + 10
Select Case .Value
Case 10: .Caption = "はじまったばかり"
Case 20: .Caption = "まだまだ"
Case 50: .Caption = "盛り上がってまいりました"
Case 80: .Caption = "もうちょい"
Case 100: .Caption = "キター": Command1.Enabled = False
End Select
End If
End With
End Sub
Private Sub Command2_Click()
objBar1.Value = 0
objBar1.ValueShow = False
objBar1.Caption = "初期状態"
Command1.Enabled = True
End Sub
Private Sub Form_Load()
Command1.Caption = "増加"
Command2.Caption = "初期化"
'ターゲットのビクチャーボックスをセット
Set objBar1 = New Class1
Set objBar1.Target = Picture1
'初期状態にする
Call Command2_Click
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'しっかり開放を忘れずに
Set objBar1 = Nothing
End Sub
----Class1----
Option Explicit
'プロパティ変数
Private picTarget As PictureBox 'ターゲットコントロール
Private lngValue As Long '現在の値を格納
Private lngBarColor As Long 'プログレスバーの色
Private lngBackColor As Long 'プログレスバーの背景色
Private lngMaxValue As Long '値の最大値
Private strCaption As String '表示する数値の単位
Private bolValueShow As Boolean '数値の表示を設定
Private lngStyle As Long '表示スタイルを設定
'--------------------------------------------------------
' 関数名 : RefreshBar
' 用途 : バーを再描画する
' 引数 : なし
' 戻り値 : なし
' 備考 : 内部でのみ利用可能です
'--------------------------------------------------------
Private Sub RefreshBar()
'バーを再描画する処理
Value = lngValue
End Sub
'--------------------------------------------------------
' プロパティ名: Target(書き込み)
' 用途 : プログレスバーにするPictureBoxを設定
' 引数 : プログレスバーにするPictureBox
' 戻り値 : なし
' 備考 : なし
'--------------------------------------------------------
Public Property Set Target(picNewTarget As PictureBox)
'プログレスバーとなるPictureBoxをセット
Set picTarget = picNewTarget
'初期化
picTarget.Cls
picTarget.AutoRedraw = True
picTarget.ScaleWidth = lngMaxValue
Value = 0
End Property
'--------------------------------------------------------
' プロパティ名: Value(読み込み)
' 用途 : プログレスバーのバーの値を取得
' 引数 : なし
' 戻り値 : プログレスバーのバーの値
' 備考 : なし
'--------------------------------------------------------
Public Property Get Value() As Long
'読み取りプロパティ
Value = lngValue
End Property
'--------------------------------------------------------
' プロパティ名: Value(書き込み)
' 用途 : プログレスバーのバーの値を設定
' 引数 : プログレスバーのバーの値
' 戻り値 : なし
' 備考 : 不正な値は調整されます
'--------------------------------------------------------
Public Property Let Value(lngNewValue As Long)
Dim strNumber As String '一時的に文字列を保持する
Dim lngTargetWidth As Long
Dim lngTargetHeight As Long
'値の調整
If lngNewValue < 0 Then
'マイナス値だった場合、0に
lngNewValue = 0
ElseIf lngNewValue > lngMaxValue Then
'Maxプロパティの値よりも大きかった場合、Max値に
lngNewValue = lngMaxValue
End If
'値の保持
lngValue = lngNewValue
With picTarget
'頻繁に呼び出されるプロパティの値を変数に格納しておく
lngTargetWidth = .ScaleWidth
lngTargetHeight = .ScaleHeight
'ターゲットのPictureBoxの内容を消去
.Cls
'いったん白色で初期化する
.DrawMode = 13 '塗りつぶしモード
picTarget.Line (0, 0)-(lngTargetWidth, lngTargetHeight), &HFFFFFF, BF
.DrawMode = 10 '反転モード
'プログレスバーの文字色設定
'基本的にバー色と同一色を使用します(表示する値によっては色を反転させる必要があるためです)
.ForeColor = lngBarColor
'数値を表示する場合
If bolValueShow Then
strNumber = lngValue & strCaption
Else
strNumber = strCaption
End If
'値の表示位置をPictureBox中央に設定
.CurrentX = lngMaxValue / 2 - .TextWidth(strNumber) / 2
.CurrentY = (lngTargetHeight - .TextHeight(strNumber)) / 2
'Valueプロパティの値をターゲットのPictureBoxに表示する
picTarget.Print strNumber
'ゴミ表示対策(このコードをコメントアウトして、動作をみれば必要性が見えてきます)
If lngValue = 0 Then lngTargetHeight = 0
'バーのスタイルによって、描画タイプ範囲を変更
Select Case Style
Case 0
'横型バーの場合
'ターゲットのPictureBoxに四角形を描く
picTarget.Line (0, 0)-(lngValue, lngTargetHeight), lngBarColor, BF
'背景色を描く
picTarget.Line (lngValue, 0)-(lngTargetWidth, .ScaleHeight), lngBackColor, BF
Case 1
'縦型バーの場合
'ターゲットのPictureBoxに四角形を描く
picTarget.Line (0, lngTargetHeight)-(lngTargetWidth, lngTargetHeight - lngValue), lngBarColor, BF
'背景色を描く
picTarget.Line (0, 0)-(lngTargetWidth, lngValue), lngBackColor, BF
End Select
'ターゲットのPictureBoxの表示を更新
.Refresh
End With
End Property
'--------------------------------------------------------
' プロパティ名: BarColor(読み込み)
' 用途 : プログレスバーのバーの色を取得
' 引数 : なし
' 戻り値 : プログレスバーのバーの色
' 備考 : ターゲットのPictureBoxのFillColorプロパティとの関連
' はありません
'--------------------------------------------------------
Public Property Get BarColor() As Long
BarColor = lngBarColor
End Property
'--------------------------------------------------------
' プロパティ名: BarColor(書き込み)
' 用途 : プログレスバーのバーの色を設定
' 引数 : プログレスバーのバーの色
' 戻り値 : なし
' 備考 : ターゲットのPictureBoxのFillColorプロパティとの関連
' はありません
'--------------------------------------------------------
Public Property Let BarColor(lngNewBarColor As Long)
lngBarColor = lngNewBarColor
'バーを再描画する
RefreshBar
End Property
'--------------------------------------------------------
' プロパティ名: Max(読み込み)
' 用途 : プログレスバーの値の最大値を取得
' 引数 : なし
' 戻り値 : プログレスバーの値の最大値
' 備考 : 初期値は100です
'--------------------------------------------------------
Public Property Get Max() As Long
'読み取りプロパティ
Max = lngMaxValue
End Property
'--------------------------------------------------------
' プロパティ名: Max(書き込み)
' 用途 : プログレスバーの値の最大値を設定
' 引数 : プログレスバーの値の最大値
' 戻り値 : なし
' 備考 : 初期値は100です
'--------------------------------------------------------
Public Property Let Max(lngNewMax As Long)
'書き込みプロパティ
'値の保持
lngMaxValue = lngNewMax
'ターゲットのプロパティをセット
picTarget.ScaleWidth = lngMaxValue
picTarget.ScaleHeight = lngMaxValue
'バーを再描画する
RefreshBar
End Property
Private Sub Class_Initialize()
'オブジェクトの初期化処理
'各変数の初期値をセット
lngValue = 0
'プログレスバーの色を指定
lngBarColor = &H800000
'プログレスバーの背景色を指定(ここでは白)
lngBackColor = &HFFFFFF
'プログレスバーの値の最大値
lngMaxValue = 100
'プログレスバーの数値の単位
strCaption = ""
'数値を表示するようにする
bolValueShow = True
End Sub
'--------------------------------------------------------
' プロパティ名: Caption(読み込み)
' 用途 : プログレスバーのバーの値の単位を取得
' 引数 : なし
' 戻り値 : プログレスバーのバーの値の単位
'--------------------------------------------------------
Public Property Get Caption() As String
Caption = strCaption
End Property
'--------------------------------------------------------
' プロパティ名: Caption(書き込み)
' 用途 : プログレスバーのバーの値の単位を設定
' 引数 : プログレスバーのバーの値の単位
' 戻り値 : なし
'--------------------------------------------------------
Public Property Let Caption(strNewCaption As String)
strCaption = strNewCaption
'バーを再描画する
RefreshBar
End Property
'--------------------------------------------------------
' プロパティ名: ValueShow(読み込み)
' 用途 : プログレスバーに値を表示するか否かを取得
' 引数 : なし
' 戻り値 : プログレスバーに値を表示するか否か
' True 表示する(初期値)
' False 表示しない
'--------------------------------------------------------
Public Property Get ValueShow() As Boolean
ValueShow = bolValueShow
End Property
'--------------------------------------------------------
' プロパティ名: ValueShow(書き込み)
' 用途 : プログレスバーに値を表示するか否かを設定
' 引数 : プログレスバーに値を表示するか否か
' True 表示する(初期値)
' False 表示しない
' 戻り値 : なし
'--------------------------------------------------------
Public Property Let ValueShow(bolNewValue As Boolean)
bolValueShow = bolNewValue
'バーを再描画する
RefreshBar
End Property
'--------------------------------------------------------
' プロパティ名: BackColor(読み込み)
' 用途 : プログレスバーの背景色を取得
' 引数 : なし
' 戻り値 : プログレスバーの背景色
' 備考 : ターゲットのPictureBoxのBackColorプロパティを
' 直接操作しても、変更は反映されません
' 通常は白色(初期値)を使用される事をお勧めします
'--------------------------------------------------------
Public Property Get BackColor() As Long
BackColor = lngBackColor
End Property
'--------------------------------------------------------
' プロパティ名: BackColor(書き込み)
' 用途 : プログレスバーの背景色を設定
' 引数 : プログレスバーの背景色
' 戻り値 : なし
' 備考 : ターゲットのPictureBoxのBackColorプロパティを
' 直接操作しても、変更は反映されません
' 通常は白色(初期値)を使用される事をお勧めします
'--------------------------------------------------------
Public Property Let BackColor(lngNewBackColor As Long)
lngBackColor = lngNewBackColor
'バーを再描画する
RefreshBar
End Property
'--------------------------------------------------------
' プロパティ名: Style(読み込み)
' 用途 : プログレスバーのスタイルを取得
' 引数 : なし
' 戻り値 : プログレスバーのスタイル
' 0 横型バー
' 1 縦型バー
' 備考 : デフォルトは横型です
'--------------------------------------------------------
Public Property Get Style() As Long
Style = lngStyle
End Property
'--------------------------------------------------------
' プロパティ名: Style(書き込み)
' 用途 : プログレスバーのスタイルを設定
' 引数 : プログレスバーのスタイル
' 0 横型バー
' 1 縦型バー
' 戻り値 : なし
' 備考 : デフォルトは横型です
'--------------------------------------------------------
Public Property Let Style(lngNewStyle As Long)
lngStyle = lngNewStyle
'最大値を再設定
Max = lngMaxValue
'バーを再描画する
RefreshBar
End Property
お礼
>回答者の方へ 回答ありがとうございました。 TAGOSAKU7さんのご指摘通り、 今回の場合ですと、 別フォームに進捗表示(処理実行中に メッセージをフォームを出して、終わったら消える)で 良いと思います。 プログレスバーを出すほどの事では無い訳でして… ソースの例などがありましたら 再度書き込み願います。