| |
こんばんは。
見ている方が全員同じものを見ていないと中々こういう
問題は処理しづらい と思いませんか？
新規ブックにユーザーフォーム（Userform1）だけ作成してください。
（コントロールは、動的に作成しますから、要りません）
標準モジュールに
'===========================================================
Sub main()
Dim i As Long
With Cells(1, 1)
.value = 0
Call init_progress_form
Do Until .value = 20000
Call set_progress_form(.value, 20000, "実行中")
.value = .value + 1
Loop
Call term_progress_form
End With
End Sub
別の標準モジュールに
'===============================================================
Option Explicit
Sub init_progress_form()
With UserForm1
.Width = 270
.Height = 114
With .Controls.Add("Forms.Label.1", , True)
.Name = "Lbl状態"
.Left = 12
.Top = 12
.Width = 60
.Height = 18
.Font.Size = 14
.TextAlign = 2
.SpecialEffect = 2
End With
With .Controls.Add("Forms.Label.1", , True)
.Name = "Lbl総計"
.Left = 12
.Top = 42
.Width = 200
.Height = 18
.SpecialEffect = 2
.ForeColor = &HFFFFFF
.TextAlign = 2
End With
With .Controls.Add("Forms.Label.1", , True)
.Name = "Lblパーセント"
.Left = 216
.Top = 48
.Width = 30
.Height = 12
.SpecialEffect = 0
.TextAlign = 3
End With
With .Controls.Add("Forms.Label.1", , True)
.Name = "Lblバー"
.Left = 12
.Top = 42
.Width = 0
.Height = 18
.SpecialEffect = 0
.BackColor = &H800000
End With
.Show vbModeless
End With
End Sub
'===============================================================
Sub set_progress_form(value As Variant, amount As Variant, Optional status As Variant = "")
With UserForm1
.Controls("LBl状態").Caption = status
.Controls("Lblパーセント").Caption = Format(value / amount, "0%")
.Controls("Lblバー").Width = .Controls("Lbl総計").Width * value / amount
DoEvents
End With
End Sub
'===============================================================
Sub term_progress_form()
Unload UserForm1
End Sub
これでmainを実行して別のタスクをアクティブにして試してください。
勿論、アクティブにしたタスクがCPUを握りっぱなしなら、そりゃあ動作は止まりますが、
通常のＨＰを表示しているＩＥ等に切り替えても上記のmainは作動していますよ！！
尚、バックグラウンドのプログラムについて
ＨＴＴＰ://winxp.1123.info/010/post_2.html
（頭のＨＴＴＰは直してください）
こんな情報もありますから、参考にしてください。
|
|
ichinose
- 07/3/26(月) 20:06 -
