２つのユーザフォームを同時進行表示させる
office365
やりたい内容は、下記2つの内容を同時進行で表示させたい
１．タイムカウント表示（オブジェクト名TextBox1）
２．プログレスバー表示（オブジェクト名ProgressBar1）
１は最初に設定された数値から1[s]ずつ00:00までカウントダウンする
分と秒の表示だけでOK
70[S]だったら起動した時に01:10と表示し1[S]ごとに減算表示し00:00で終了
２は上記数値に到達するまでの時間を１００％として経過をプログレスバーで表示させる
70[S]だったら1秒ごとにプログレスバーを棒グラフっぽく表示
35[S]で50%(棒グラフが真ん中の状態）
70[S]で100%(棒グラフMAX状態）
上記を表現するマクロが下記の通り
１
Sub countdown_time()
Dim h As Integer
Dim m As Integer
Dim s As Integer
'// 引数：Date型
'B2セルにカウントタイム秒を時刻表示 例 70[s]の場合 0:01:10
h = Hour(Range("B2"))
m = Minute(Range("B2"))
s = Second(Range("B2"))
Debug.Print "現在の時：" & h
Debug.Print "現在の分：" & m
Debug.Print "現在の秒：" & s
Range("B4") = m 'B2に入力された時刻の分表示 例 70[s]の場合 1
Range("C4") = s 'B2に入力された時刻の秒表示 例 70[s]の場合 10
UserForm1.lblFinishTime.Caption = Range("B1").Text '予定終了時刻
Dim limit As Date, cnt_d As Double
limit = DateAdd("s", Range("C4"), Time) '現在時刻に指定秒を足す
limit = DateAdd("n", Range("B4"), limit) '現在時刻に指定分を足す
rng = 0 '一時停止の時間リセット
UserForm1.Show vbModeless 'タイマーをモードレス表示
UserForm1.Repaint '強制表示
Do
cnt_d = (DateDiff("s", Time, limit) + rng) / 60 '指定時刻 - 現在時刻 (+ 一時停止) を秒で表して60で割ったもの
UserForm1.TextBox1 = Int(cnt_d) & ":" & Format(Round((cnt_d - Int(cnt_d)) * 60, 0), "00") '分：秒 で表示
If UserForm1.TextBox1 = "0:00" Then Exit Do 'ゼロになったらDoを抜ける
DoEvents 'イベントを実行
Loop
End Sub
２
Sub status_bar()
Dim i As Long
UserForm5.Show vbModeless
With UserForm5
.ProgressBar1.Max = Worksheets("MENU").Range("C2") 'C2セルにカウントする数値を設定 （例 70)
.ProgressBar1.Min = 0
For i = .ProgressBar1.Min To .ProgressBar1.Max
.ProgressBar1.Value = i
.パーセント.Caption = Int(i / .ProgressBar1.Max * 100) & "%"
.Repaint
Application.Wait Now() + TimeValue(Worksheets("MENU").Range("E2").Value) 'E2セルはカウントインターバルタイム 1[s]の場合、文字列で0:00:01を設定
Next
End With
End Sub
１にuserform1
２にuserform5
をしていますが、ユーザフォームは1つでもよいです。
2つのユーザフォームを表示させるのに
vbModelessを使用すればよいとのことですが、
上記2つのマクロを同時進行表示できない状態です。
２つのユーザフォーム共にShowModalはfalseにしてます。
可能であるなら、上記１，２を1つのユーザフォームで同時実行したい。
無理ならばuserform1,userform5の2つ別々のユーザフォームのままで同時実行で可です。
お礼
ありがとうございました。 大変参考になりました。