ステータスバーを一定時間後に更新する

質問

office365

一定時間後（10[S]毎)にステータスバーの進捗状態を更新させたい

下記は、iを１ずつカウントしたらステータスバーを1%～100%まで表示するマクロです。

Sub sample()
'
Dim i As Long
Dim num As Long

UserForm5.Show vbModeless
UserForm5.StartUpPosition = 0
UserForm5.Top = 0
UserForm5.Left = 0

i = 1
num = 100

For　 i = 1 To 　num

With UserForm5

.ProgressBar1.Value = i
.パーセント.Caption = Int(i / num * 100) & "%"
.Repaint

End With

Next

End Sub

上記マクロに、10[s]毎にステータスバーの進捗状態を更新するマクロとしたいのですが、その方法がわからずべたのマクロで教えていただきたく。

10[S]たったら1%
20[S]たったら2%
…
1000[s]たったら100%
のステータスバーを表示する構成にしたいのです。

回答No.1

kkkkkm · ベストアンサー

以下は1秒ごとに1%増えるコードです。

TimeValue("00:00:01")
を変更して試してみてください。

Sub Test()
Dim i As Long

UserForm5.Show vbModeless
With UserForm5
.ProgressBar1.Max = 100
.ProgressBar1.Min = 0

For i = .ProgressBar1.Min To .ProgressBar1.Max
.ProgressBar1.Value = i
.パーセント.Caption = i & "%"
.Repaint
Application.Wait Now() + TimeValue("00:00:01")
Next
End With

End Sub

お礼

回答ありがとうございます。
助かりました。

TimeValue("00:00:01")を変える所も、セルの値を参照して時間を変えられる様にしました。

回答No.2

HohoPapa

ProgressBarに表示するとともに
StatusBarにも　x%を表示するんですね？

そのStatusBarとは、
formの最下行の場所ではなく
シートを表示した画面の最下行のStatusBarのことですね？

以下が、ステータスバーに表示するサンプルです。
（32ビット版限定です）

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub aaa()
　Dim i As Long

　For i = 0 To 10000
　　If i Mod 100 = 0 Then
　　　Application.StatusBar = Format(Int(i / 100), "00") & "%"
　　　DoEvents
　　End If
　　Sleep 100
　Next i

　Sleep 5000
　Application.StatusBar = False

End Sub

お礼

回答ありがとうございます。

office365は64bitなので動作しませんでしたが、office2016で動作確認できました。
なお
そのStatusBarとは、
formの最下行の場所ではなく
シートを表示した画面の最下行のStatusBarのことですね？
とありますが、最下行のStatusBarではなく、ユーザフォームを使用したStatusBarにしてます。