Labelでプログレスバーの表示

質問

いつも大変お世話になっております。

動作が重いマクロ、プログラムが多いため、
プログレスバーを表示させたいと思っています。

フォームを20個以上準備しており、
それに対し
プログレスバーを使いたいのが10個程度であり、
今後増えるかもしれません。

そのため、標準モジュールを利用し、簡単に
プログレスバーを設定できないかと思っています。

'===================
【標準モジュール Module1】

Sub　Bar_progressBarData(Byval UserFormName as string, Byval MaxData as Long,LabelName as string)
'UserFormName 引用するところ？のユーザーフォーム名
'MaxData　バーの最大値設定
'LabelName バー表示するラベル名

'ProgressBarの初期設定などをやる

End sub
'-------------------------
Sub　Bar_progressBarInt(Byval UserFormName as string, Byval MaxData as Long,LabelName as string)
'UserFormName 引用するところ？のユーザーフォーム名
'MaxData　バーの最大値設定
'LabelName バー表示するラベル名

'ProgressBarの値を増やしていく（増加させていくプログラム）

End sub

'=================
【UserForm　Test】
Sub　DataChangeGraph()

'ループが多いデータ
Call　Bar_progressBarInt(Me.Name,10,"Label1")'バーの値を増加させていく
End Sub

Private Sub UserForm_Initialize()
Call　Bar_progressBarData(Me.Name,10,"Label1")'初期設定（例として、max10にしました)
End Sub

Maxの値、プログレスデータに使用する値は
グローバルに設定してしまうというのも楽かもしれません。

しかし、この続きの肝心なプログラムが分かりません。

「プログレスバーの作り方」
h ttp://www.h3.dion.ne.jp/~sakatsu/ProgressBarTopic.htm

このサイトが良いと評判でしたので、
見ましたが何をしているのか良く分かりませんでした。

Widthを設定？
Dim sngBarMaxWidth As Single？

そして、私がやりたいこととは少し違うようです。

私がやりたいのは、フォーム上に毎回プログレスバー用のプログラムを書くのが面倒だったので、
標準モジュールとしてSubプロシージャを作成（日本語？
そして、それを引用してプログレスバーの設定を簡単に終わらせる
ということがしたかったのです。

できれば、ラベルなど
Excelに標準で備わっているものを使用したいと思っています。
プログレスバー専用のツール（参照設定などを用いるもの）
はその後にエラーが出たとき困るので、使いたくありません。

なんとなく伝わったでしょうか？

回答よろしくお願い致します。

Excel2003　VBA

回答No.3

mitarashi · ベストアンサー

#2ですが、LabelはFrameの中に入れる必要があります。位置はコードで設定しますので、Frameの中に収まっていればOKです。
Label位置はFrame内の座標で設定してありますので、Frameに属していないと判断されると、UserFormの左上に配置されると思います。
ところで、コードはお望みの事を行っているつもりです。標準モジュールの場合との違いを画像として添付します。UserForm側からは、クラスのインスタンス（クラスから生成したオブジェクト）にFrameとその中にあるLabel2個を渡し、ループの最大数を設定してやれば、以降For ～　Nextの重たい処理のループを回す毎にCountUpだけしてやれば、変数はインスタンス側で管理してくれるのが、標準モジュールの場合との違いです。

お礼

返事が遅くなり申し訳ありません。

回答ありがとうございました！
試すのに時間がかかりそうなので、
これで回答を締め切りたいと思います。

また何かあったら質問させて頂きます＾＾

ありがとうございました！

回答No.2

mitarashi

#1です。
UserFormにはフレームと、ラベル2個を置くだけで、設定はすべてクラスモジュール側で行う様にしてみました。メンバーは最小限に抑えていますが、プロパティを外部に出せば、インスタンス毎に文字色を変えるとかも出来ます。

'☆Class1 モジュール
'出典http://www.h3.dion.ne.jp/~sakatsu/ProgressBarTopic.htm

Private myFrame As Object
Private myLabel1 As Object
Private myLabel2 As Object
Private myLoopCount As Long
Private myCount As Long
Private sngBarMaxWidth As Single
Private intPercent As Integer
Private intBeforePercent As Integer

Public Sub setObjects(newFrame As Object, newLabel1 As Object, newLabel2 As Object)
Set myFrame = newFrame
Set myLabel1 = newLabel1
Set myLabel2 = newLabel2

myCount = 0
intBeforePercent = 0

With myFrame
.Height = 22
.Width = 150
.Caption = ""
.SpecialEffect = fmSpecialEffectSunken
.BorderStyle = fmBorderStyleNone
End With
sngBarMaxWidth = myFrame.Width - 2

With myLabel1
.Caption = ""
.Top = 1
.Left = 1
.Height = myFrame.Height - 2
.Width = 0
.BackColor = &H800000
End With

With myLabel2
.Caption = "" ' ％表示用ラベル
.Top = 0
.Left = 0
.Width = myFrame.InsideWidth
.Height = myFrame.InsideHeight
.TextAlign = fmTextAlignCenter
.BackStyle = fmBackStyleTransparent
.Font.Size = 18
.ForeColor = RGB(&HFF, &HCC, &H0)
End With
End Sub

Public Property Let setLoopCount(newLoopCount As Long)
myLoopCount = newLoopCount
End Property

Public Sub countUp()
If myFrame Is Nothing Then
MsgBox "Objectがセットされていません"
Exit Sub
End If
myCount = myCount + 1
intPercent = Int(myCount * 100 / myLoopCount)
If (intPercent <> intBeforePercent) Then
myLabel1.Width = sngBarMaxWidth * intPercent / 100
myLabel2.Caption = intPercent & "％"
myFrame.Repaint ' バーの再描画
End If
intBeforePercent = intPercent
End Sub

お礼

補足をさらにします。
プログレスバー用のフォームを作成しましたが、
バーが毎回上に表示されます。
ウィンドウの上の部分です。
その部分には特に何も無く、
Label1、Label2共にフォーム下のほうに置いたのですが
毎回同じ部分で表示され、
添付して頂いた画像のようになりません。

設定方法が悪いのでしょうか；

補足

＞各UserFormにフレーム＋ラベルでプログレスバーもどきを設けたいけれど、個々にコードを書くのは面倒くさいというご趣旨でしょうか。
個々にコードを書くので大丈夫なのです。
ただ、標準モジュールで初期設定などが出来れば良いという考えでした。

標準モジュールに下記のようなデータをセット？することにより
●フォーム名、Label名やフレーム名などを取得
●取得した場所のプログレスバー初期設定
●プログレスバーのMax値なども設定

【標準モジュール Module1】

Sub　Bar_progressBarData(Byval UserFormName as string, Byval MaxData as Long,LabelName as string)
'UserFormName 引用するところ？のユーザーフォーム名
'MaxData　バーの最大値設定
'LabelName バー表示するラベル名

'ProgressBarの初期設定などをやる

End sub
'-------------------------
Sub　Bar_progressBarInt(Byval UserFormName as string, Byval MaxData as Long,LabelName as string)
'UserFormName 引用するところ？のユーザーフォーム名
'MaxData　バーの最大値設定
'LabelName バー表示するラベル名

'ProgressBarの値を増やしていく（増加させていくプログラム）

End sub
’＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝－－

上記のような感じです。
こうすると、初期設定の手間が省ける上に、
Labelの名前なども引用してしまうため気になりません。
（各フォームで使っているラベル個数が違います）

下手な説明で大変申し訳ないのですが、
伝わりましたでしょうか？

回答No.1

mitarashi

各UserFormにフレーム＋ラベルでプログレスバーもどきを設けたいけれど、個々にコードを書くのは面倒くさいというご趣旨でしょうか。
クラスモジュールにするのが良いと思いますが、吟味している時間がとれません。とりあえず試験をしてみたというレベルですが投稿させていただきます。（プロパティのセット漏れ等のエラー処理も何もありません）
クラスモジュールの作り方は下記等をご参照下さい。
http://codezine.jp/article/detail/499

'☆Userformモジュール
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Dim myClass As Class1
Dim countUp As Long

'あくまで動作試験用
Private Sub CommandButton1_Click()
Dim i As Long

For i = 1 To countUp
DoEvents: DoEvents: DoEvents
myClass.countUp
Sleep 200
Next i
End Sub

Private Sub UserForm_Initialize()
Set myClass = New Class1
countUp = 100
With myClass
.setObjects Me.Frame1, Me.Label1, Me.Label2
.setLoopCount = countUp
End With
End Sub

'☆Class1 モジュール
'http://www.h3.dion.ne.jp/~sakatsu/ProgressBarTopic.htmを若干アレンジさせていただきました。

Private myFrame As Object
Private myLabel1 As Object
Private myLabel2 As Object
Private myLoopCount As Long
Private myCount As Long
Private sngBarMaxWidth As Single
Private intPercent As Integer
Private intBeforePercent As Integer

Public Sub setObjects(newFrame As Object, newLabel1 As Object, newLabel2 As Object)
Set myFrame = newFrame
Set myLabel1 = newLabel1
Set myLabel2 = newLabel2
With myLabel1
.Top = 1
.Left = 1
.Height = myFrame.Height - 2
.Width = 0
.BackColor = &H800000
End With
myLabel2.Caption = "" ' ％表示用ラベル
sngBarMaxWidth = myFrame.Width - 2
myCount = 0
intBeforePercent = 0
End Sub

Public Property Let setLoopCount(newLoopCount As Long)
myLoopCount = newLoopCount
End Property

Public Sub countUp()
myCount = myCount + 1
intPercent = Int(myCount * 100 / myLoopCount)
If (intPercent <> intBeforePercent) Then
myLabel1.Width = sngBarMaxWidth * intPercent / 100
myLabel2.Caption = intPercent & "％"
myFrame.Repaint ' バーの再描画
End If
intBeforePercent = intPercent
End Sub

補足

回答ありがとうございます。
クラスの使い方の参考サイトまで、ありがとうございます！

ひとつ言い忘れていたのですが、
プログレスバーを表示しているときなどに
Excelファイルを操作
（シートをクリックしたり）
出来なくしたいと思っています。

現段階ではモーダレス？ではないので
シートを操作することは出来なくなっています。

お恥ずかしい話ですが、
ActiveSheetを多用しておりまして、
編集最中なのです。

ActiveSheet　⇒ WorkSheet("Sheet1")
のように変更中です。
（シート名が多量にあるため、
　変更するのに時間がかかりそうです）

これが終わり次第、教えて頂いたプログラムを
やってみたいと思います！

とても時間のかかる作業だったとは思いますが、
ありがとうございました！

毎回毎回、mitarashi様にはお世話になってます；
本当に、助かります！