_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/ _/ ソフト名:プログレスバー表示アドイン (Ver1.0) _/ 種 別:フリーソフト _/ 開発環境:Windows98SE & Excel2000SR1(9.0.3822) _/ 動作環境:上記環境にて動作確認してあります。 _/      2000からの新機能は使っていないのでExcel97でも _/      動作すると思いますが環境が無い為、確認していません。 _/      (Excel95では動作しません) _/ 著作権者:角田 桂一 _/ 免 責 :このマクロを使用したことで発生したいかなる損害に _/      ついても、作者は一切責任を負わないものとします。 _/ 再配布 :再配布は自由です。 _/ 転 載 :パスワードロックしていない関係上、出典と内容を保証する意味 _/      で転載はご遠慮願います。このサイトの紹介で対応してください。 _/ 履 歴 :2000/10/19 Ver1.0作成 _/ その他 :McAfee VirusScan(4.0.3a)にてウィルスチェックしてあります。 _/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/  処理時間の長いマクロを実行させる場合    『しばらくお待ち下さい』や実行キャンセル  に対応する為に、皆さんはどうしてますか?   ・MsgBoxを使ってみる     表示したらOKをクリックするまで制御がマクロに戻らない。     OKをクリックすると今度はメッセージが消えてしまう。→ 役立たず (T_T)   ・Excel2000でモードレス表示のUserFormを用意する     Excel97では機能が無い。     モーダルフォームからでは怒られる。(;_;)   ・UserForm の CommandButton_Clickにマクロを記述してメッセージ用    のラベルコントロールに表示する。    でも、どこまで進んだのか判らないから、あの【青いヤツ】が欲しい!!      ・キャンセルボタンを使うにはUserForm 上でマクロを動かして、ループ中に    [DoEventsメソッド]を実行すれば、キー入力を受け取れるけど、シート上の    コマンドボタンや「マクロの実行ダイアログ」から動かしているフォーム    のないマクロにもキャンセルを付けたい。   ・[EnableCancelKeyプロパティ=xlErrorHandler]にして、Escキー押下をエラー    トラップ(Err.Number=18)で検知する。   ・どちらにしても、マクロごとに1つ1つ組み込むのは疲れる〜。(~_~)  〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜  《プログレスバー表示アドイン Ver1.0(ktPrgsWait.xla)》を使えば全て解決します。    フォームからだろうが、「マクロの実行」からだろうが、サブルーチンコール    だけで、簡単に【キャンセルボタン付きプログレスバー】を表示します。    ただし、ループ処理本体を独立した【 Public Sub 】にする必要があります。    下記サンプルコード参照。 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -    利用する側のブックにUserForm定義は一切不要。ktPrgsWait.xlaをアドイン    フォルダ(C:\Program Files\Microsoft Office\Office\Library 等)に保存    して、利用する側のブックから【参照設定】するだけです。 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -    オプションで表示形式を選択できます(メッセージは3行)。      ・メッセージとプログレスバーとキャンセルボタン      ・メッセージとプログレスバー      ・メッセージとキャンセルボタン      ・メッセージだけ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -    動作の仕組みは[ktPrgsWaitHelp.xls]のシート上で図解してあります。   『Application.Run メソッド』を使った、ちょっと裏技的な仕組みで実現して    います。不安に思う方がいるかもしれないので、[ktPrgsWait.xla]のVBAPro    ject にはパスワードを付けていません。各自マクロコードを実際に見て、   『これなら大丈夫』と納得した上でお使い下さい。    なお、マクロコードの改変はご遠慮願います。 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -    配布ファイルは圧縮してあります。解凍すると      ktPrgsWait.xla   ‥‥‥本ソフトのアドインブック      ktPrgsWaitHelp.xls ‥‥‥本ソフトの仕組みの図解とパラメータ説明                   サンプルコードが含まれていますので、マクロ                   の有効確認ダイアログが開きます。      ktPrgsWaitReadMe.txt‥‥‥この文書    の3ファイルになります。 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -    アドインブックには、UserForm の『閉じるボタン(X)』をグレー表示で無効に    するサブルーチン(API利用)も一緒に入っていますので役立てて下さい。    利用方法はマクロコード上に記載してあります。 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 以降の内容は[ktPrgsWaitHelp.xls]から『仕組の図解』シートに記載されている 【パラメータの説明】および サンプルコードをコピーしたものです。 【重 要】 ktRunPrgsWaitをCallするプロシジャーと、ktInitPrgsWait/ktDispPrgsWaitをCallする プロシジャーは必ず分けて作成して下さい。ひとつのプロシジャーで全てを済ませる事 は出来ません。 ktRunPrgsWaitをCallするプロシジャーは標準/UserForm/シートモジュールのどこに 記述しても構いません。 ktInitPrgsWait/ktDispPrgsWaitを記述するプロシジャー(ktRunPrgsWaitのパラメータ に指定したプロシジャー)を作成する場所は【標準モジュール】だけです。また、そのプロ シジャーは必ず【 Public 】とし、【 引数(Variant型 )をひとつだけ定義 】して下さい。 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ktRunPrgsWait(CallProc, CallModule, CallBook) プログレスフォームの表示 および フォームから起動してもらうループ処理プロシジャーの指定   CallProc ‥‥実際にループ処理を行なうプロシジャー名:任意                       。。。。。。。   CallModule‥‥プロシジャーが記述してある標準モジュール名:任意 [ktRunPrgsWait]を実行するプロシジャーと同じ 標準モジュールでも構わない。   CallBook ‥‥必ず ThisWorkbook.Name と記述する   (注)ここで指定するプロシジャーは【Public 】とし、ダミーの引数     (Variant型)をひとつだけ定義します(必須。マクロの実行ダイ     アログに表示させない為に必要です)。     親プロシジャーとのデータの引継ぎには[Public変数]を利用     してください。 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ktInitPrgsWait([Comment1],[Comment2],[Comment3],         [PrgsBar],[CancelBtn],[MaxLoop],[CancelInterval]) プログレスフォームの利用方法とメッセージの指定   Comment1〜3‥‥省略可。表示するWaitメッセージを指定。 省略すると「しばらくお待ち下さい」になります。   PrgsBar ‥‥‥省略可。プログレスバーの表示有無を指定。 True:表示する(既定値),False:表示しない   CancelBtn‥‥‥省略可。中断ボタンを有効にするかを指定。 True:中断ボタンは有効(既定値),False:無効   MaxLoop ‥‥‥省略可。[PrgsBar=True または 省略]の場合は必須。 進捗率を計算する為のループ予定回数を指定。   For i = 1 To 200 → 200回   For i = 500 To 100 Step -1 → 401回   For i = 100 To 10000 Step 5 → 1981回   ループ予定回数 = ABS((終了 - 開始) / Step) + 1     (For Eachでコレクションを扱う場合はCountプロパティの値)   CancelInterval‥省略可。[CancelBtn=True または 省略]の場合に指定。   中断ボタンを押せるように、OSへ制御を戻す(DoEvents)ループ   間隔を指定(省略時は1→毎回)。   "毎回"にすると処理時間が長くなり過ぎますので、ループ回数と   の兼ね合いで10(10回に1回)とか50(50回に1回)などを指定して   ください。値は任意です。 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ktDispPrgsWait(CancelClick) プログレスバーの再描画と中断ボタンの取り込み。   CancelClick‥‥省略不可。【Boolean型の変数】を指定する。 [CancelBtn=True または 省略]の場合に中断ボタンが押され ているかどうかが返される。 True:中断ボタンが押された,False:押されていない [CancelBtn=False]の場合は、毎回Falseが返る。 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 『ktInitPrgsWait』をもう一度実行すれば、新たな設定でループをやり直す ことも出来ます(サンプルコード参照)。 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/ '_/  _/ '_/ プログレスバー/お待ち下さいメッセージ  _/ '_/ サンプルコード  _/ '_/  _/ '_/ Made by K.Tsunoda 2000/10/19 (Free Soft)  _/ '_/  _/ '_/ "ktPrgsWait.xla"をアドインフォルダ等に保存して _/ '_/ [ツール]→[参照設定]→[ktPrgsWaitをチェック]  _/ '_/  _/ '_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/ Option Explicit '========(呼び元はUserForm/ワークシート/標準モジュールどこでも構わない)===== Sub ProgressTest() ' ループ処理の起動 Call ktRunPrgsWait("ProgressLoop", "SampleModule", ThisWorkbook.Name) End Sub '============(ループ処理本体は必ず標準モジュールに[Public]で記述する)======= Public Sub ProgressLoop(ByVal Dummy As Variant) ' マクロの実行ダイアログに表示されないようにダミーの引数をひとつ設ける(必須) Dim i As Long Dim CancelClick As Boolean ' 中断ボタンのOn/Off受け取り Dim MsgResp As Integer Call ktInitPrgsWait("時間の掛かる処理を実行中です", _ "しばらくお待ちください", _ "『中断ボタン』で処理中断します", _ MaxLoop:=(80000 - 50 + 1), _ CancelInterval:=50) For i = 80000 To 50 Step -1 ' 〜〜〜〜〜〜〜〜〜〜〜〜 ' ここに実際の処理を記述 ' 〜〜〜〜〜〜〜〜〜〜〜〜 Call ktDispPrgsWait(CancelClick) ' プログレスバーの更新 If (CancelClick = True) Then MsgResp = MsgBox("中断ボタンが押されました" & _ vbCrLf & "中断しますか?", _ vbExclamation + vbYesNo + vbDefaultButton2) If (MsgResp = vbYes) Then Exit For End If End If Next i MsgBox ("次はプログレスバーなしで実行") '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Call ktInitPrgsWait("時間の掛かる処理を実行中です", _ "しばらくお待ちください", _ "『中断ボタン』で処理中断します", _ PrgsBar:=False, CancelInterval:=10) For i = 50 To 80000 ' 〜〜〜〜〜〜〜〜〜〜〜〜 ' ここに実際の処理を記述 ' 〜〜〜〜〜〜〜〜〜〜〜〜 Call ktDispPrgsWait(CancelClick) ' 中断ボタンの確認 If (CancelClick = True) Then MsgResp = MsgBox("中断ボタンが押されました" & _ vbCrLf & "中断しますか?", _ vbExclamation + vbYesNo + vbDefaultButton2) If (MsgResp = vbYes) Then Exit For End If End If Next i MsgBox ("次は中断ボタン無効で実行") '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Call ktInitPrgsWait("時間の掛かる処理を実行中です", _ "しばらくお待ちください", _ MaxLoop:=70000, _ CancelBtn:=False) For i = 1 To 70000 ' 〜〜〜〜〜〜〜〜〜〜〜〜 ' ここに実際の処理を記述 ' 〜〜〜〜〜〜〜〜〜〜〜〜 Call ktDispPrgsWait(CancelClick) ' プログレスバーの更新 Next i ' このProcが終了すると、 ' [ktFormPrgsWait]のActivateイベントに制御が戻り ' そこで[ktFormPrgsWait]がUnLoadされ、最終的に ' [ktFormPrgsWait]のShowを指示した[Call ktRunPrgsWait]ステートメントの ' 次に制御が戻る End Sub ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~