2021/09/23

先行予約可能な備品予約・貸出システム

• １．背景
• ２．システム概要
• 　２－１．予約時
• 　２－２．予約取消時
• 　２－３．確認時
• 　２－４．管理者による「貸出／返却」処理
• 　　２－４－１．予約 → 貸出
• 　　２－４－２．貸出中 → 返却
• ３．プログラムの流れ
• 　３－１．予約の流れ
• 　３－２．予約取消の流れ
• 　３－３．確認の流れ
• 　３－４．貸出・返却の流れ
• ４．操作用シート(Sheet1)
• 　４－１．レイアウト
• 　４－２．数式の設定
• 　４－３．条件付き書式の設定
• 　４－４．シートモジュール
• ５．データ用シート(Sheet2)
• ６．標準モジュール(Module1)
• 　６－１．定数・変数宣言と初期設定
• 　６－２．貸出表上操作ボタンの起動マクロ
• 　　６－２－１．「予約」ボタン
• 　　６－２－２．「取消」ボタン
• 　　６－２－３．「確認」ボタン
• 　　６－２－４．「貸出/返却」ボタン
• 　６－３．選択したセル範囲のチェック
• 　　よりみち（Variant型とBoolean型の比較）
• 　６－４．テーブルの絞り込み／解除
• 　６－５．絞り込みデータの配列化
• 　　よりみち（Trnsposeでのデータ型変化とReDimの位置）
• 　６－６．列内の最大値を取得
• 　６－７．テーブルへのデータ追加・更新
• 　６－８．テーブルのデータ削除
• 　　よりみち（テーブルでの削除方法）
• 　６－９．貸出表データの更新
• 　６－１０．開始終了日から貸出表の該当セル範囲を出力
• 　６－１１．予約番号から貸出表の該当セル範囲を出力
• ７．予約用ユーザーフォーム(UserForm1)
• 　７－１．フォーム上レイアウト
• 　７－２．フォームモジュール
• 　　７－２－１．起動時設定
• 　　７－２－２．予約実行
• ８．予約取消用ユーザーフォーム(UserForm2)
• 　８－１．フォーム上レイアウト
• 　８－２．フォームモジュール
• 　　８－２－１．初期設定等
• 　　８－２－２．フォーム準備・起動
• 　　８－２－３．予約取消の実行
• ９．確認用ユーザーフォーム(UserForm3)
• 　９－１．フォーム上レイアウト
• 　９－２．フォームモジュール
• 　　９－２－１．初期設定
• 　　９－２－２．フォーム準備・起動
• １０．管理者用ユーザーフォーム(UserForm4)
• 　１０－１．フォーム上レイアウト
• 　１０－２．フォームモジュール
• 　　１０－２－１．初期設定
• 　　１０－２－２．フォーム準備・起動
• 　　１０－２－３．貸出／返却処理の実行
• １１．データテーブル・マクロの非表示化
• 　１１－１．シートの非表示
• 　１１－２．マクロの非表示
• １２．最後に
• サンプルファイル

１．背景

以前このサイトで「備品の予約･貸出･記録ができる貸出管理表」を紹介しました。これは「その時に空いている備品を借りられる」というコンセプトで、基本はセル内数式を使い、マクロは最小限にしたシステムでした。
しかし、もっと計画的に「いつからいつまで借りる予約をしたい」という状況もあると思いますので、今回は「先の予約が可能な貸出表」を紹介します。

なおデータはListObject（テーブル）を使って操作しています。同じくListObjectを使った以下の項も参考にして頂けると助かります。
・DVD等の内容･保管場所等管理システム
・ToDoリストで個人タスク管理
・会社番号検索システム

２．システム概要

今回システムは、図２－１のように「備品名・管理番号」と「日付欄」に囲まれた「予約等のガントチャート」で出来ています。

図２－１

縦軸の「備品名・管理番号」のリストは、手書きで書き込んでいます。管理番号は全ての備品を通してユニーク（重複が無い）であるのが望ましいとは思いますが、今回は「備品名＋管理番号」のセットでユニークであればOKとしています。

日付欄では、今回は「日曜日から始まる２週間」を表示させています。日付は左上のスクロールバーで移動可能で、その横の「今週」ボタンをクリックすることで、表示の１週目が今週になるようにしています。
また、日付の上（ワークシートの２行目）には「年」を表示しています。年を跨ぐ時には、図２－２のように「1月1日」の上に「次の年」を表示させています。

図２－２

備品を借りる手順は、「予約（記号：Y）」→「貸出（K）」→「返却（H）」という順序で状態が動くことを想定しました。
貸出表内では、その状態の変化を「薄いオレンジ色」→「赤色」→「灰色」とセル色が変化することで表し、またセル内には「記号＋予約番号」を記入することで、登録情報の呼出しのキーにしています。

２－１．予約時

備品を予約するには、図２－３のように、縦軸「備品名・管理番号」と横軸「日程」を見ながら、「予約したい期間」をセル選択①します。その状態で上部の「予約」ボタン②をクリックします。
すると予約のダイアログ③が起動しますので、選択した備品情報 及び予約期間を確認した上で、テキストボックス欄に「氏名（借用希望者）」「部署」「取り消す時に使用するパスワード」を入力④します。氏名は必須項目としています。入力が完了したら「OK」ボタン⑤をクリックします。

図２－３

すると図２－４のようにダイアログは消え⑥、セル選択した日程期間が薄いオレンジ色⑦に変わります。これで予約が完了となります。


図２－４

なお図２－５のように、選択したセル範囲内に「他の予約等が含まれている⑧」時に「予約」ボタンをクリック⑨すると、予約が出来ない旨のコメントが表示⑩されます。この際には、借用期間の変更、または備品の変更が必要になります。

図２－５

今回システムでは「備品１つに対して、１予約」とする（理由：保存データには１つの備品の枠しか無い）ため、予約時も「１行のみを選択」する必要があります。そこで貸出表内を選択する際は、「単一行のみを選択可能」にしています。
つまり図２－６のように、マウスで複数行選択しても、左クリックを戻すと「単一行選択になる」ように修正をします。

図２－６

また図２－７のように、貸出表内から貸出表外までを選択した際にも「貸出表内のみを選択した」状態に修正をします。

図２－７

なお貸出表外のみを選択した時には、選択領域の修正はしません。

２－２．予約取消時

一旦取得した予約の取り消しは、予約をしたユーザー本人が行います。まず図２－８のように「取得した予約の一部をセル選択①」し、上部の「取消」ボタン②をクリックします。

図２－８

すると取消用のダイアログ③が起動しますので、ダイアログ上の取消内容を確認します。また予約していた期間は、セル選択状態④になりますのでダブルチェックが出来ます。
ダイアログ下部に「予約時に設定したパスワード⑤」を入力後、一番下の「削除」ボタン⑥をクリックします。

図２－９

この操作により、図２－１０のように予約が取り消され⑦ます。

図２－１０

なお、図２－１１の左側のように「複数項目に跨ってセル選択」した時には、「どれを選択しているのかが特定できない」ため、コメントを出して作業終了します。「１つのみの項目と空白セル」の場合は、取消処理が可能です。
また図２－１１の右側のように「空白セルのみ」の場合も「対象項目が特定できない」ため、コメントを出して処理終了します。
この「項目を選択する時の注意点」は、この後説明する「確認」「貸出/返却」処理においても、共通です。

図２－１１

また、予約以外の項目（貸出中・返却済）を選択して取消処理をしようとした場合、図２－１２のようにダイアログは起動しますが、パスワード欄への入力、及び取消実行ボタンの操作を出来なくしています。
この場合は、キャンセルボタンでダイアログ終了して下さい。

図２－１２

２－３．確認時

貸出表を見て「どこの誰が予約しているのか」「どこの誰が借りているのか」を調べる時には、図２－１３のように「項目のセルを選択①」した後、上部の「確認」ボタン②をクリックします。

図２－１３

起動した確認ダイアログ③の情報を確認後、ＯＫボタン⑤で終了します。
なお選択した項目の状態（予約中・貸出中・返却済）は、ダイアログのタイトル部に表示されています。また期間は、セル範囲を選択状態④にしています。

図２－１４

２－４．管理者による「貸出／返却」処理

２－４－１．予約 → 貸出

今回システムでは、予約者は予約開始日になったら「管理者のところに備品を借りにくる」ことを想定しています。管理者は備品を予約者に貸し出すのと同時に、システムの上で「項目を『予約』状態から『貸出』状態に変更」する必要があります。

予約取消・確認の時と同様に「作業する予約項目の一部をセル選択①」し、「貸出／返却」ボタン②をクリックします（図２－１５）。

図２－１５

すると図２－１６のように、貸出／返却用のダイアログが起動③しますので、内容を確認の上、一番下のパスワード欄（テキストボックス）に「管理者用のパスワード」を入力④します。
（今回の「サンプルファイル」では、管理者パスワードは「""（長さゼロの文字列）」にしていますので、オリジナル状態ではパスワードの入力は不要です。）

図２－１６

最後に「貸出」ボタン⑤をクリックすると、図２－１７のように、予約したセル範囲の背景色が「薄いオレンジ色→赤色」に変化⑥し、セル内の文字列の先頭部分が「Y（予約）→K（貸出）」に変わります。

図２－１７

ちなみに図２－１７のように、「9/14～9/16」で予約された項目を「9/14」に処理（＝備品を貸出）した場合は、「9/14～9/16」が貸出中（セルが赤くなる）となります（9/14より前に処理をしても同じです）。

一方予約開始日より後の「9/15」に処理した場合は、9/15より貸し出したのですから貸出期間は「9/15～9/16」となるため、図２－１８のように「9/14（貸出をしなかった日）」は「空白セル⑦」となります。
尚「予約→貸出」の場合、返却予定日は変更しません。次の予約が入っている可能性がありますので、返却日は守らせる必要があるからです。

図２－１８

２－４－２．貸出中 → 返却

備品を借りた人は、返却予定日になったら管理者へ備品を返却に来ます。管理者は備品を受取ると共に、システムへの入力をします。
「作業する貸出項目の一部をセル選択①」し、「貸出／返却」ボタン②をクリックします（図２－１９）。

図２－１９

貸出／返却用のダイアログが起動③しますので、内容を確認の上、一番下のパスワード欄（テキストボックス）に「管理者用のパスワード」を入力④します。（今回の「サンプルファイル」では、入力不要です）

図２－２０

最後に「返却」ボタン⑤をクリックすると、図２－２１のように、貸出中のセル範囲の背景色が「赤色→灰色」に変化⑥し、セル内の文字列の先頭部分が「K（貸出）→H（返却）」に変わります。

図２－２１

ちなみに図２－２１のように、「9/14～9/16」で貸し出された項目を「9/16」に処理（＝備品を返却）した場合は、「9/14～9/16」の返却済（セルが灰色になる）となります（9/16以降に処理をしても同じです）。

一方返却予定日より前の「9/15」に処理した場合は、9/15まで貸し出したのですから貸出期間（実績）は「9/14～9/15」となるため、図２－２２のように「9/16（貸出をしなかった日）」は「空白セル⑦」となります。

図２－２２

３．プログラムの流れ

３－１．予約の流れ

図３－１

「予約」ボタンをクリックした時は、まず「CheckSelect1関数」を使って「ユーザーが選択したセル範囲が、貸出表内か。また既に予約等をしている項目に重なっていないか」を確認し、フォーム（UserForm1）を起動します。
セル選択範囲から「備品名・管理番号」「予約期間」を計算し、ユーザーが入力した氏名・部署などの情報と、データテーブルの予約番号（Yno）の最大値（＋１）を合わせて登録情報とし、データテーブルに追加（TableDataInプロシージャ）します。
最後に、データ追加された最新状態のデータをもとに、貸出表を更新します。

３－２．予約取消の流れ

図３－２

「取消」ボタンをクリックした時は、まず「CheckSelect2関数」を使って「ユーザーが選択したセル範囲が、貸出表内か。また範囲内のセル値（状態＋Yno）は１種類だけか（空白セルは許容）」を確認し、フォーム（UserForm2）にYno（予約番号）を渡して起動します。
フォーム内の「項目情報」は、Yno（予約番号）を元にデータテーブル側から取得します。
削除して良ければ、データテーブルのYno（予約番号）の行を削除（TableDataDelプロシージャ）します。
最後に、データ削除された最新状態のデータをもとに、貸出表を更新します。

３－３．確認の流れ

図３－３

「確認」ボタンをクリックした時は、まず「CheckSelect2関数」を使って「ユーザーが選択したセル範囲が貸出表内か。また範囲内のセル値は１種類だけか（空白セルは許容）」を確認し、フォーム（UserForm3）にYno（予約番号）を渡して起動します。
フォーム内の「項目情報」は、Yno（予約番号）を元にデータテーブル側から取得します。
確認が終わったらフォームを閉じます。

３－４．貸出・返却の流れ

図３－４

「貸出/返却」ボタンのクリック時は、まず「CheckSelect2関数」を使って「ユーザーが選択したセル範囲が貸出表内か。また範囲内のセル値は１種類だけか（空白セルは許容）」を確認し、フォーム（UserForm4）にYno（予約番号）を渡して起動します。
フォーム内の「項目情報」は、Yno（予約番号）を元にデータテーブル側から取得します。
状態は「予約→貸出→返却」の順序で進みますので、「現在の状態の次の状態」にするために、Yno（予約番号）の行のStatus列（状態）のデータを更新（TableDataUpプロシージャ）します。
最後に、データ更新された最新状態のデータをもとに、貸出表を更新します。

４．操作用シート(Sheet1)

４－１．レイアウト

操作用のシートは、今回Sheet1に作成しています。Sheet1の上には
　・ScrollBar1、CommandButton1（ActiveXコントロール）
　・Button １～４（フォームコントロール）
のコントロールを図４－１のように配置しています。ボタンの表面Captionは、配置時に書き込んでいます。
なお予約等のデータは、Sheet2に保存しています。

図４－１

ScrollBar1は、スライドさせることで「表示週を切り替える」役目を持っています。スクロールバーのValue値が１つ動くことで「１つの週が移動」するようにしています。
スクロールバーの初期のプロパティは「Min値＝０、Max値＝32767」ですが、初期のままにしてあります。32767週というと642年間になってしまいますので、気になる方は変更して下さい。

フォームコントロールのボタンには、以下のプロシージャ（標準モジュールに記載）を登録します。
　・Button 1（予約）･･･Yoyaku（登録マクロ）
　・Button 2（取消）･･･　Torikeshi（〃）
　・Button 3（確認）･･･　Kakunin（〃）
　・Button 4（貸出/返却）･･･　Kanri（〃）

Sheet1上の文字列は、図４－２のように手入力で書き込みをし、罫線・背景色なども手動で設定しています。

図４－２

また備品の種類が増えると、最上部のボタンをクリックするための画面スクロールが大変になりますので、ウィンドウ枠の固定を行ってます。ウィンドウ枠固定は、今回の場合５行目を行選択した上で、「表示」タブ→「ウィンドウ」グループ→「ウィンドウ枠の固定」ボタンでウィンドウ枠の固定を実施します。

４－２．数式の設定

Sheet1の３行目は「日付行」です。基準である「D3セル」には、マクロ側から基準日を書き込みます。
E3セルより右側には「＝左セル値＋１」の数式を入力することで、連続した日付を表示しています（図４－３）。

図４－３

Sheet1の２行目は「年」を表示します。全ての日付の上に年を表示しても良いのですが、ゴチャゴチャしてしまう為、先頭日付の上の「D2セル」と、年を跨いだ時だけ表示されるように、図４－４のような数式をE2セル～Q2セルに書き込んでいます。
数式は「真下の日付の年」と「一つ左隣の日付の年」とが異なれば、「真下の日付の年を表示」すると言う意味になります。

図４－４

４－３．条件付き書式の設定

今回システムでは、Sheet1の日付（横軸）と備品名・管理番号（縦軸）で囲まれたセルに「状態記号＋予約番号」をマクロで書き込みます。そして、そのセルに書かれた文字列の先頭文字列に条件付き書式を反応させることで、項目をガントチャート風に表示させています。

項目を表示させる領域（今回サンプルシートでは、D5～Q10セル）には、図４－５のように条件付き書式を設定しています。
状態は「予約（先頭文字列＝Y）」「貸出（K)」「返却（H）」の３種ですので、その先頭文字列を条件式にし、背景色を「薄いオレンジ色」「赤色」「灰色」に設定しています。

図４－５

４－４．シートモジュール

Sheet1の貸出表上の日付を移動するスクロールバー（ScrollBar1：ActiveXコントロール）を操作した時のイベントプロシージャが図４－６です。

1. '==========　⇩(1)　日付変更用スクロールバー値変更時　============
2. Private Sub ScrollBar1_Change()
3. 　Call System_Initialize
5. 　DispDateS.Value = StartDay + ScrollBar1.Value * 7
7. 　Call T1make
8. End Sub

図４－６

３行目「Call System_Initialize」は、標準モジュールの図６－５を呼び出しています。
今回のように「システム起動のためのボタンが無い」システムでは、通常でしたらブックモジュールにWorkbook_Openイベントを置き、その中で「システムに共通して必要な初期設定」を実行させます。但し「何らかのエラーが発生」したり「Endステートメント」を実行されたりした時には、ブックを開き直すかWorkbook_Openイベントプロシージャを実行し直すかが必要となります。
「エラーが頻発するシステム製作時」には、Workbook_Openイベントでの初期設定は非常に使いにくいため、今回のようにボタン類が少ないシステム（操作の対象が絞られる）では、それぞれのボタン類を操作した時に初期設定マクロが呼び出されるようにするのも一つの手だと思っています。

５行目「DispDateS.Value = StartDay + ScrollBar1.Value * 7」は、図６－５内で設定した「日付欄の先頭セル（DispDateS：サンプルファイルではD3セル）」に、図６－１で設定したシステム起算日（定数StartDay）＋ScrollBar1のValue値×7（週の日数）の値を設定しています。
これにより日付欄先頭セルに入った日付の後ろに、図４－３の日付の数式により２週間分の日付が並ぶことになります。

７行目「Call T1make」は、標準モジュールの図６－２５を呼び出し、貸出表内にデータを貼り付け、条件付き書式によりガントチャート風な表が作られます。

貸出表上のスクロールバーの横に配置した「今週」ボタンをクリックした時に呼び出されるのが図４－７です。

10. '==========　⇩(2))　「今週」ボタンクリック時　============
11. Private Sub CommandButton1_Click()
12. 　Me.ScrollBar1.Value = Int((Date - StartDay) / 7)
13. End Sub

図４－７

１２行目「Me.ScrollBar1.Value = Int((Date - StartDay) / 7)」では、スクロールバーのValue値に、システム起算日（定数StartDay）から今週までの週数を設定しています。
設定値を変更することで、更に図４－６を呼び出すことになり、貸出表の日付が変更されます。

なお、図４－７には「Call System_Initialize」のコードが入っていませんが、１２行目で使っている定数「StartDay」は宣言部で定数宣言していますので、例えばブックを開いた直後にクリックもエラーが出る事はありません。その後の図４－６を呼出し、３行目「Call System_Initialize」を実行することで「システムに共通して必要な初期設定」がされることになります。

Sheet1のセル選択を変更した時に呼び出されるイベントプロシージャが図４－８です。

15. '==========　⇩(3)　セル選択変更時　============
16. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
17. 　Call System_Initialize
19. 　On Error Resume Next
20. 　　Intersect(Target, T_1).Rows(1).Select
21. 　On Error GoTo 0
23. End Sub

図４－８

１７行目「Call System_Initialize」は、図４－６の時と同様に「システムに共通して必要な初期設定」を呼出しています。ここで初期設定が必要な理由は、２０行目で「変数T_1」を使用するためです。

２０行目「Intersect(Target, T_1).Rows(1).Select」では、貸出表をセル選択した時に、
　①貸出表の内側（セル範囲：T_1）と外側を跨った状態でセル選択した場合は「内側のみ」
　②複数行を選択した場合は「先頭行のみ」
を再選択させるようにしています。
①の役目は２０行目の中の「Intersect(Target, T_1)」の部分、②の役目は「Rows(1)」となります。

一方で貸出表の外側をセル選択した場合には、「Intersect(Target, T_1)」の部分がNothingとなりエラーが発生します。ですので１９行目「On Error Resume Next」により、２０行目のエラーによるマクロ停止を避けます。画面上は「ユーザーが選択したままの状態」となります。

５．データ用シート(Sheet2)

備品予約～貸出～返却までのデータはSheet2で管理しています。
データ域はテーブル操作を可能とするためListObjectの設定をしています。図５－１の通り、テーブルの見出し（列名）を手動で設定し、またテーブル名は「T_2（図６－１の３９行目で定数設定）」と手動設定しています。

図５－１

列は全部で９つ設けました。

列	列名	ﾃﾞｰﾀ型	内容
1	Yno	Long	予約番号
2	Bname		備品名
3	Kno		備品管理番号
4	name		氏名
5	Dept		部署
6	PW		予約時パスワード
7	StartD	Date	開始日
8	EndD	Date	終了日
9	Status	String	状態

図５－２

Excelのテーブルでは「列内で型の異なるデータの混在は可能」です。Excel自体がデータ型を大らかに扱ってくれて助かる面もありますが、マクロで制御する時にはデータ型を意識することが大切と思います。特にFilterを使った絞り込み時に「抽出されない」事もあり得ます。今回、検索に使用する列に対しては、図５－２のように「データ型」を意識してコードを組み立てました。

１列目のYnoは、データを一意に扱うため「ユニークな番号」である必要があります。もしデータを手動で編集する際は充分に気を付けて下さい。
３列目のKnoは、サンプルファイルでは数値を使用していますが、文字列（例えば、T101 等）でもOKです。
４～６列目はユーザー入力値が入りますが、数値でも文字列でもOKです。
７～８列目の「StartD」「EndD」は、予約・貸出等の日程となりますが、今回は「書式を（例えばyyyy/mm/ddのように）一定にする」必要は無さそうです。（「DVD等の内容・保管場所等管理システム」では、テーブルの日付データを『完全一致』で抽出したため、書式まで揃える必要があった）

Excelのテーブル（ListObject）は、１つのワークシート上に複数作ることが可能です。しかし、その場合「データを削除」するコードとして「EntireRow.Delete」を使用すると、別なテーブルのデータを勝手に削除してしまう可能性があります。
今回は「テーブルは１つのみ」ですので心配ありませんが、コードとしては「テーブル内のデータ行のみを削除」する手法を使っています（詳細は「よりみち」を参照下さい）。

６．標準モジュール(Module1)

標準モジュールには、データ処理（予約・貸出・返却など）の前処理、テーブルを操作するマクロ等を置いています。

６－１．定数・変数宣言と初期設定

システム全体で使用する定数・変数の宣言を標準モジュール先頭の宣言部で行います（図６－１）。

25. '==========　⇩(4)　宣言部　============
26. Public T_1 As Range 　　　　　　　　　　　　　　 '←貸出表ガントチャート部を表すRangeオブジェクト
27. Private Const T1sh As String = "Sheet1" 　　　　 '←貸出表が有るワークシート名
28. Private Const T1table As String = "D5:Q10" 　　 '←貸出表のガントチャート部のセル範囲
29. Public Const T1Bname As Long = 2 　　　　　　　 '←備品名が記入されている列位置
30. Public Const T1Kno As Long = 3 　　　　　　　　 '←管理番号が記入されている列位置
32. Public DispDateS As Range 　　　　　　　　　　　 '←表示日付の初日のセル
33. Public DispDateW As Integer 　　　　　　　　　　 '←表示日付の期間
34. Public Const StartDay As Date = "2021/1/3" 　　 '←システム起算日（日曜日）
35. Public Const DayCell As String = "D3" 　　　　　 '←貸出表の初日セル位置
37. Public T_2 As ListObject 　　　　　　　　　　　 '←データ部を表すListObjectオブジェクト
38. Private Const T2sh As String = "Sheet2" 　　　 '←データが有るワークシート名
39. Private Const T2table As String = "T_2" 　　　 '←データのテーブル名

図６－１

２６～３０行目は、図６－２のように「貸出表の全体レイアウト」に関する値です。

図６－２

２６行目「Public T_1 As Range」は、貸出表内のガントチャートが表示される領域を「T_1」としています。２７～２８行目の定数を使用し、図６－５の４５行目でRangeオブジェクトとしてセットします。
２７行目「Private Const T1sh As String = "Sheet1"」は、貸出表のシート名を文字列として定数宣言しています。
２８行目「Private Const T1table As String = "D5:Q10"」は、貸出表内のガントチャートが表示される領域のセル範囲を文字列として定数宣言しています。
２９行目「Public Const T1Bname As Long = 2」は、備品名の列位置を定数宣言しています。ユーザーがセル選択した行位置と、このT1Bname値から、備品名を割り出しています。
３０行目「Public Const T1Kno As Long = 3」は、備品の管理番号の列位置を定数宣言しています。

３２～３５行目は、図６－３のように「貸出表の日付」に関する値です。

図６－３

３２行目「Public DispDateS As Range」は、貸出表の日程欄の初日（先頭セル）をDispDateSと宣言しています。
３３行目「Public DispDateW As Integer」は、貸出表の日程欄の幅（表示日数）をDispDateWと宣言しています。
３４行目「Public Const StartDay As Date = "2021/1/3"」は、システムの起算日を設定します。貸出表（Sheet1)の４行目の曜日と合わせるために、起算日は日曜日とします。
３５行目「Public Const DayCell As String = "D3"」は、貸出表の日程欄の初日（先頭セル）のセル範囲を文字列として定数宣言しています。

３７～３９行目は、図６－４のように「データシート」に関する値です。

図６－４

３７行目「Public T_2 As ListObject」は、データシートであるテーブルを「T_2」としています。３８～３９行目の定数を使用し、図６－５の４６行目でRangeオブジェクトとしてセットします。
３８行目「Private Const T2sh As String = "Sheet2"」は、テーブルを置いたシート名を文字列として定数宣言しています。
３９行目「Private Const T2table As String = "T_2"」は、テーブル名を文字列として定数宣言しています。

図６－１の定数・定数を使い、図６－５の「System_Initializeプロシージャ」では「システム全体で使用するオブジェクト等の設定」を行っています。
なお、貸出表の上に配置したコントロール類（スクロールバー、ボタン等）を操作するたびに図６－５は呼び出されるようにしていますので、ブックモジュールのWorkbook_Openの代わりの役目を担っている反面、都度呼び出されるので「必要な時だけ呼出しする」ように工夫しています。

41. '==========　⇩(5)　システム初期設定　============
42. Public Sub System_Initialize()
44. 　If T_1 Is Nothing Then
45. 　　Set T_1 = ThisWorkbook.Sheets(T1sh).Range(T1table)
46. 　　Set T_2 = ThisWorkbook.Sheets(T2sh).ListObjects(T2table)
48. 　　Set DispDateS = ThisWorkbook.Sheets(T1sh).Range(DayCell)
49. 　　DispDateW = T_1.Columns.Count
50. 　End If
52. End Sub

図６－５

４５行目「Set T_1 = ThisWorkbook.Sheets(T1sh).Range(T1table)」では、貸出表のガントチャート表示部のセル範囲をRangeオブジェクトとして設定しています。
４６行目「Set T_2 = ThisWorkbook.Sheets(T2sh).ListObjects(T2table)」では、Sheet2のデータ部分をListObjectオブジェクト（テーブル）として設定しています。
４８行目「Set DispDateS = ThisWorkbook.Sheets(T1sh).Range(DayCell)」は、貸出表の日程欄の先頭セル位置をRangeオブジェクトとして設定しています。
４９行目「DispDateW = T_1.Columns.Count」は、貸出表のガントチャート表示部の列幅（列数）を変数DispDateWに代入しています。列数は、４５行目で設定した変数T_1（貸出表のガントチャート表示部のセル範囲）から算出しています。

４５～４９行目は、初めに１回だけ実行すれば、そのあとは必要ありません。「実行済み」の証拠は、例えばT_1のRangeオブジェクトがセットされている（Not T_1 Is Nothing ）ことですから、４４行目「If T_1 Is Nothing Then」で「セットされていない時（＝初回）だけ４５～４９行目を実行」させています。

６－２．貸出表上操作ボタンの起動マクロ

貸出表の「予約」「取消」「確認」「貸出/返却」ボタンのクリックで呼び出されるのが、以下の４つのプロシージャです。
本来は貸出表シート（Sheet1）のシートモジュールに置くのが正しいのかもしれませんが、これらのプロシージャ内で標準モジュール内の関数を多用しているため、説明のし易さから「標準モジュール置き」としました。
尚、これらをシートモジュール置きにした場合は、プロシージャのスコープ指定のPublicをPrivateにすることができます。

６－２－１．「予約」ボタン

「予約」ボタンをクリックした時に呼び出されるのが図６－６です。

54. '==========　⇩(6)　「予約」ボタン　============
55. Public Sub Yoyaku()
56. 　Dim Ans As Boolean 　　 '←選択中のセル範囲の状態
58. 　Call System_Initialize
60. 　If Intersect(Selection, T_1) Is Nothing Then Exit Sub
62. 　Ans = CheckSelect1(Selection)
63. 　If Ans = False Then Exit Sub
65. 　UserForm1.Show
67. End Sub

図６－６

５８行目「Call System_Initialize」は、図６－５を呼び出し、システム内で使用するオブジェクトの設定をしています。このコードは、「予約」ボタンのみで無く、最初にユーザーが操作する可能性のある「取消」「確認」「貸出/返却」ボタンでも実行しています。

６０行目「If Intersect(Selection, T_1) Is Nothing Then Exit Sub」は、セル選択範囲と「T_1（貸出表のガントチャート表示範囲）」の重なっている範囲を調べ、重なりが無い（ガントチャート表示範囲外のセルを選択している）場合にプロシージャを抜け出します。状態としては「ボタンを押しても何も反応しない」形になります。

６２行目「Ans = CheckSelect1(Selection)」は、図６－１０のCheckSelect1関数を呼び出しています。引数には、ユーザーが選択したセル範囲（Selection）を渡します。
CheckSelect1は「指定したセル範囲が全て空白セルの場合、Trueを戻す」関数ですので、「ユーザーが予約したい期間」に「予約済み・貸出済み等」が存在しない場合はTrue、存在した場合はFalseとなり、その値は変数Ansに代入されます。

予約したい期間内に「予約済み・貸出済み等」が存在していると、予約が重複してしまうので、予約許可が出来ません。
ですので、６３行目「If Ans = False Then Exit Sub」で、Falseの時は「予約処理を中止」し、Trueの時だけ６５行目「UserForm1.Show」で、予約用のフォームを起動させます。

６－２－２．「取消」ボタン

「取消」ボタンをクリックした時に呼び出されるのが図６－７です。

70. '==========　⇩(7)　「取消」ボタン　============
71. Public Sub Torikeshi()
72. 　Dim Ans As Variant 　　 '←選択中のセル範囲の状態
74. 　Call System_Initialize
76. 　If Intersect(Selection, T_1) Is Nothing Then Exit Sub
78. 　Ans = CheckSelect2(Selection)
79. 　If Ans = False Then Exit Sub
81. 　On Error Resume Next
82. 　　YnoRange(CLng(Ans), Selection.Row).Select
83. 　On Error GoTo 0
84. 　Call UserForm2.UFstart(CLng(Ans))
86. End Sub

図６－７

７４行目「Call System_Initialize」は、システム内で使用するオブジェクトの設定をしています。
７６行目「If Intersect(Selection, T_1) Is Nothing Then Exit Sub」は、セル選択範囲とT_1範囲の重なりを調べ、ガントチャート表示範囲外をセル選択している場合には、プロシージャを抜け出します。

７８行目「Ans = CheckSelect2(Selection)」は、図６－１１のCheckSelect2関数を呼び出しています。引数には、ユーザーが選択したセル範囲（Selection）を渡します。
CheckSelect2は「指定したセル範囲にセルの文字列が１種類だけ存在する場合その文字列（先頭文字を除く）を戻し、文字列がゼロ（全て空白セル）または複数種類存在する場合はFalseを戻す」関数です。なお、セル範囲内の空白セルは無視しています。また「予約」の時に使用した「CheckSelect1」関数と似ていますが異なる機能になっています。

ですので「処理したい項目」を「１種類のみ選択」している場合は選択した文字列（予約番号）、「選択していない」または「複数種類選択してしまった」場合はFalseとなり、その値は変数Ansに代入されます。
７９行目「If Ans = False Then Exit Sub」は、「選択していない」「複数種類選択してしまった」場合にはプロシージャを抜けて処理を中止します。

８２行目「YnoRange(CLng(Ans), Selection.Row).Select」は、図６－３０のYnoRange関数を呼び出しています。第一引数に「予約番号Yno」、第二引数に「行位置」を指定することで「予約番号Ynoのセル範囲（貸出表内）」のRangeオブジェクトを戻します。
そのRangeオブジェクトに対してSelectメソッドを使用していますので、「予約番号Ynoのセル範囲を選択」します。つまりユーザー側は「予約番号の一部を含むセルを選択」するだけで、マクロ側で「予約番号のセルを全て選択」することになります。

「１種類のみ選択」している場合に８１行目以降を実行するのですが、もしユーザーが貸出表のセルの文字列を「存在しない予約番号」に編集してしまった時、８２行目のYnoRange関数はセル範囲では無く「Range型の初期値であるNothing」を戻して来ます。
すると８２行目のセル選択（.Select）は出来ませんので、エラーが発生します。
そこで８１行目「On Error Resume Next」でエラー回避をしています。

８４行目「Call UserForm2.UFstart(CLng(Ans))」は、UserForm2のフォームモジュールに載せた「UFstart」プロシージャを呼び出します。UFstartプロシージャには引数として「予約番号Yno」を渡し、フォーム上にYnoの情報を記載後、フォーム本体を起動させます。
上記と同様に「存在しない予約番号」に編集してしまった時にも８４行目は実行されてしまいますが、フォーム起動準備の中でデータが取得できない時にはフォームを開かない処理にしてあります。

６－２－３．「確認」ボタン

「確認」ボタンをクリックした時に呼び出されるのが図６－８です。

87. '==========　⇩(8)　「確認」ボタン　============
88. Public Sub Kakunin()
89. 　Dim Ans As Variant 　　 '←選択中のセル範囲の状態
91. 　Call System_Initialize
93. 　If Intersect(Selection, T_1) Is Nothing Then Exit Sub
95. 　Ans = CheckSelect2(Selection)
96. 　If Ans = False Then Exit Sub
98. 　On Error Resume Next
99. 　　YnoRange(CLng(Ans), Selection.Row).Select
100. 　On Error GoTo 0
101. 　Call UserForm3.UFstart(CLng(Ans))
103. End Sub

図６－８

「確認」も、コード内容としては図６－７とほとんど同じです。異なるのは、１０１行目で呼び出すプロシージャが確認用フォームであるUserForm3にあることです。以下に簡単に説明しますので、詳細は「取消ボタン」を参照願います。

９１行目「Call System_Initialize」は、システム内で使用するオブジェクトの設定をしています。
９３行目「If Intersect(Selection, T_1) Is Nothing Then Exit Sub」は、貸出表外を選択している場合に処理を中止します。
９５行目「Ans = CheckSelect2(Selection)」では、選択した予約番号、またはFalseが変数Ansに代入されます。
９６行目「If Ans = False Then Exit Sub」は、「未選択」又は「複数種類選択を選択」している場合は処理を中止します。
９９行目「YnoRange(CLng(Ans), Selection.Row).Select」は、「予約番号Ynoのセル範囲を選択」します。
９８行目「On Error Resume Next」は、９５行目で取得した予約番号が存在しない番号だった場合、９９行目がエラーになることを防いでいます。
１０１行目「Call UserForm3.UFstart(CLng(Ans))」は、確認用フォームであるUserForm3のフォームモジュールに載せた「UFstart」プロシージャを呼び出し、予約番号Ynoに結び付いた情報が書き込まれたフォームを起動させます。

６－２－４．「貸出/返却」ボタン

「貸出/返却」ボタンをクリックした時に呼び出されるのが図６－９です。

105. '==========　⇩(9)　「貸出/返却」ボタン　============
106. Public Sub Kanri()
107. 　Dim Ans As Variant 　　 '←選択中のセル範囲の状態
109. 　Call System_Initialize
111. 　If Intersect(Selection, T_1) Is Nothing Then Exit Sub
113. 　Ans = CheckSelect2(Selection)
114. 　If Ans = False Then Exit Sub
116. 　On Error Resume Next
117. 　　YnoRange(CLng(Ans), Selection.Row).Select
118. 　On Error GoTo 0
119. 　Call UserForm4.UFstart(CLng(Ans))
121. End Sub

図６－９

「確認」も、コード内容としては図６－７、図６－８とほとんど同じです。異なるのは、１１９行目で呼び出すプロシージャが貸出/返却用フォームであるUserForm4にあることです。以下に簡単に説明しますので、詳細は「取消ボタン」を参照願います。

１０９行目「Call System_Initialize」は、システム内で使用するオブジェクトの設定をしています。
１１１行目「If Intersect(Selection, T_1) Is Nothing Then Exit Sub」は、貸出表外を選択している場合に処理中止します。
１１３行目「Ans = CheckSelect2(Selection)」では、選択した予約番号、またはFalseが変数Ansに代入されます。
１１４行目「If Ans = False Then Exit Sub」は、「未選択」又は「複数種類選択を選択」している場合は処理を中止します。
１１７行目「YnoRange(CLng(Ans), Selection.Row).Select」は、「予約番号Ynoのセル範囲を選択」します。
１１６行目「On Error Resume Next」は、１１３行目で取得した予約番号が存在しない番号だった場合、１１７行目がエラーになることを防いでいます。
１１９行目「Call UserForm4.UFstart(CLng(Ans))」は、貸出/返却用フォームであるUserForm4のフォームモジュールに載せた「UFstart」プロシージャを呼び出し、予約番号Ynoに結び付いた情報が書き込まれたフォームを起動させます。

６－３．選択したセル範囲のチェック

図６－６の６２行目から呼び出される「CheckSelect1」関数プロシージャが図６－１０です。引数としてセル範囲RRを受取ります。
関数の役目としては、引数で受け取ったセル範囲が「全て空白セル」であればTrue、「空白では無いセルがある場合」はFalse　を戻します。Falseの場合はコメントを出してから終了します。

123. '==========　⇩(10)　選択セル範囲のチェック１　============
124. Private Function CheckSelect1(RR As Range) As Boolean
125. 　Dim r As Long 　　 '←１つ１つのセル
127. 　For Each r In RR
128. 　　If Not r.Value = "" Then
129. 　　　MsgBox "選択域に既予約日が含まれています"
130. 　　　Exit Function
131. 　　End If
132. 　Next r
134. 　CheckSelect1 = True
135. End Function

図６－１０

１２７行目「For Each r In RR」で、引数として受け取ったセル範囲RRを１セルずつ調べて行きます。
１２８行目「If Not r.Value = "" Then」で、調べるセルが空白セルでは無かった時には、１２９～１３０行目を実行します。
１２９行目「MsgBox "選択域に既予約日が含まれています"」でコメントを出し、130行目「Exit Function」でプロシージャを抜け出します。プロシージャは１２４行目で「Boolean型」と宣言されていますので、初期値のFalseが戻ることになります。
全てのセルを調査し終わった（＝全て空白セルだった）後、１３４行目「CheckSelect1 = True」で戻り値をTrueと設定しますので、「全て空白セル」であれば「True」が戻ることになります。

図６－７の７８行目、図６－８の９５行目、図６－９の１１３行目から呼び出される「CheckSelect2」関数プロシージャが図６－１１です。引数としてセル範囲RRを受取ります。

137. '==========　⇩(11)　選択セル範囲のチェック２　============
138. Private Function CheckSelect2(RR As Range) As Variant
139. 　Dim buf As String 　　 '←セルの内容を入れる変数
140. 　Dim r As Range 　　　 '←１つ１つのセル
142. 　For Each r In RR
143. 　　If Not r.Value = "" Then
144. 　　　If buf = "" Or buf = r.Value Then
145. 　　　　buf = r.Value
146. 　　　Else
147. 　　　　MsgBox "指定範囲内に複数の貸出情報が含まれています"
148. 　　　　CheckSelect2 = False
149. 　　　　Exit Function
150. 　　　End If
151. 　　End If
152. 　Next r
154. 　If buf = "" Then
155. 　　MsgBox "選択範囲に貸出情報が含まれていません"
156. 　　CheckSelect2 = False
157. 　　Exit Function
158. 　End If
160. 　CheckSelect2 = Mid(buf, 2)
161. End Function

図６－１１

１４２行目「For Each r In RR」では、引数として受け取ったセル範囲RRを１つずつ調べていきます。
１４３行目「If Not r.Value = "" Then」は、調べるセルが空白セルで無かった時に、１４４～１５０行目を実行します。

１４４行目「If buf = "" Or buf = r.Value Then」は、セル値を入れている変数bufが「空（＝初めて値が代入される時）」または「最初に代入した値と同じ」だった場合に調査を継続し、「そうでなかった場合（前に代入した値と異なる値の時）」は調査をSTOPさせています。
これにより、範囲内のセルの値が１種類か否かを見極めています。

初めてセル値を代入する場合、又はまだ１種類目のセル値の場合は、１４５行目「buf = r.Value」で、変数bufにセルの値を代入します。
２種類目が来てしまった時は、１４７行目「MsgBox "指定範囲内に複数の貸出情報が含まれています"」でコメントを出し、１４８行目「CheckSelect2 = False」で関数戻り値にFalseを設定後、１４９行目「Exit Function」で関数を終了します。

この関数は、１３８行目でも分かる通りVariant型の戻り値を返すことにしています。もし１４８行目で「CheckSelect2 = False」と設定せず、初期値のまま戻すとすると「Empty」が戻ることになります。 戻った先では、例えば図６－９では１１３行目「Ans = CheckSelect2(Selection)」ですから変数AnsにEmptyが代入され、次の１１４行目「If Ans = False Then Exit Sub」では「Empty」と「False」が比較されることになります。 違う型の値を比較していますが、Empty = False　はTrueとなり、特にエラー等は出ません。これは数値として見た時には両方ともゼロになるためだと考えていますが、もし気持ち悪いという場合は、１１４行目は「If IsEmpty(Ans) Then Exit Sub」とすることになります。 私も同じ感情を持つのですが、図６－６（予約工程）と同じ構文として揃えたかったので、ここは「If Ans = False Then Exit Sub」を使い、その代わりCheckSelect2の戻り値をEmptyでは無く、わざわざFalseにしてから戻しています。 「もう少し良い方法があるのでは」とは思っているのですが、「逆に分かり難くなった」と思われた方には申し訳ありません。

１５４行目「If buf = "" Then」は、変数bufに何も入っていない（＝引数のRRのセル範囲は全て空白セルだった）時には、予約番号が取得できず、取消・確認・貸出/返却の処理が出来ないため、１５５行目「MsgBox "選択範囲に貸出情報が含まれていません"」でコメントを出し、１５６行目「CheckSelect2 = False」で関数の戻り値をFalseに設定し、１５７行目「Exit Function」で関数を抜けます。

セル範囲内のセル値が１種類の場合は、１６０行目「CheckSelect2 = Mid(buf, 2)」を実行し、文字列の２番目以降（＝先頭の１文字を削除）を関数の戻り値にしています。今回システムでは、T1makeプロシージャ（図６－２５）の２６１行目で、セルへは「状態を表す１文字」＋「予約番号」を貼り付けていますので、戻り値は「予約番号」となります。

６－４．テーブルの絞り込み／解除

まず、絞り込みをするプロシージャは図６－１２になります。引数として下記の３つを受け取ります。

	引数	内容	備考
1	T	ListObject
2	col	絞り込む列	列番号 または 列名
3	word	絞り込みキー	｢=｣｢<｣｢*｣等は､呼出し元で付ける

163. '==========　⇩(12)　テーブルの絞り込み　============
164. Public Sub TableFilter(T As ListObject, col As Variant, word As String)
165. 　T.Range.AutoFilter field:=T.ListColumns(col).Index, Criteria1:=word
166. End Sub

図６－１２

１６５行目「T.Range.AutoFilter field:=T.ListColumns(col).Index, Criteria1:=word」では、絞り込みを実施しています。

AutoFilterメソッドのパラメータfieldには「フィールド番号を整数で指定」することになっていますので、引数colも整数のみとすれば一番楽です。しかし今回はデータベースらしく「列名」でもOKになるように考えました。
列位置を計算するため「T.ListColumns(col).Index」の式で「列名→列位置」へと変換しています。また、列位置で引数を受取ったとしても「列位置→列位置」という計算結果になるため問題ありません。

また、パラメータCriteria1には、引数で受け取った絞り込みキー「word」をそのまま渡しています。式の等号・不等号などは、このプロシージャを呼び出す側で付けることとしました。

また、絞り込みを解除するプロシージャが図６－１３です。全列一斉に解除する方式で、引数ListObjectを受取ります。

168. '==========　⇩(13)　テーブルの絞り込み解除　============
169. Public Sub TableFilterOff(T As ListObject)
170. 　T.ShowAutoFilter = False
171. 　T.ShowAutoFilter = True
172. End Sub

図６－１３

「DVD等の内容･保管場所等管理システム」の時には、絞り込み解除のプロシージャの式として「T.Range.AutoFilter field:=T.ListColumns(col).Index」のように「fieldパラメータのみを指定」し、その作業をFor～Nextで全列に渡って繰り返すことで解除しました。

しかし今回は考え方を変え、「フィルターを一旦非表示にし、その後再表示させる」方法にしました。
１７０行目「T.ShowAutoFilter = False」でフィルターを非表示にし、１７１行目「T.ShowAutoFilter = True」で再表示させます。これにより「非表示にした際に全列の絞り込みが解除され、再表示することで全解除のフィルター付き状態」になります。

処理速度を比較するため10列100行のテーブルで試した所、従来の「１列ずつ解除」法が約0.055秒、今回の「一旦非表示」法が約0.015秒と、約1/4に縮まっていますので、その点では有利かと思います。

なお何らかの手違いで、テーブルをフィルター非表示にしてしまった時でも、TableFilterOffプロシージャを実行することでフィルターは再表示されます。ですので、今回システム内で絞り込みを行う前には必ずTableFilterOffを実行させています。

６－５．絞り込みデータの配列化

テーブルのデータを絞り込み、その絞り込まれたデータのみを配列にして戻す関数が図６－１４です。引数としてListObjectオブジェクトを受取ります。

174. '==========　⇩(13)　絞り込みデータの配列化　============
175. Public Function SearchList(T As ListObject) As Variant
176. 　Dim r As Range 　　　　 '←絞り込まれたﾃﾞｰﾀの内の1行分
177. 　Dim buf As Variant 　　 '←戻り値とする一時的な配列
178. 　Dim i As Long 　　　　　 '←ｶｳﾝﾀ変数（配列の行位置）
179. 　Dim j As Long 　　　　　 '←ｶｳﾝﾀ変数（配列の列位置）
180. 　Dim icnt As Long 　　　 '←絞り込みﾃﾞｰﾀのｾﾙ個数
181. 　Dim wcnt As Long 　　　 '←ﾃｰﾌﾞﾙの列数
183. 　On Error Resume Next
185. 　　icnt = T.DataBodyRange.SpecialCells(xlCellTypeVisible).Count
186. 　　wcnt = T.HeaderRowRange.Count
187. 　　ReDim buf(1 To Int(icnt / wcnt), 1 To wcnt)
189. 　　For Each r In T.DataBodyRange.SpecialCells(xlCellTypeVisible).Rows
190. 　　　i = i + 1
192. 　　　For j = 1 To UBound(buf, 2)
193. 　　　　buf(i, j) = r.Cells(1, j)
194. 　　　Next j
196. 　　Next r
198. 　　SearchList = buf
200. 　On Error GoTo 0
201. End Function

図６－１４

まず１８５行目「icnt = T.DataBodyRange.SpecialCells(xlCellTypeVisible).Count」では、絞り込まれた結果（可視セル範囲）のセル数を変数icntに代入しています。
この際、テーブルに１つもデータが無い（DataBodyRangeが存在しない）場合や、絞り込まれた結果全てが非表示（SpecialCells(xlCellTypeVisible)が存在しない）場合には、エラーが発生します。このエラーで停止するのを防止するため、１８３行目「On Error Resume Next」を設定しています。

一方で、１８６行目「wcnt = T.HeaderRowRange.Count」では、テーブルの列数を取得し変数wcntに代入しています。
この「icnt」「wcnt」は、図６－１５のような関係になります。

図６－１５

列数はwcntそのまま、行数はicntをwcntで割った商となりますので、１８７行目「ReDim buf(1 To Int(icnt / wcnt), 1 To wcnt)」で、配列のサイズが定まります。

１８９行目「For Each r In T.DataBodyRange.SpecialCells(xlCellTypeVisible).Rows」では、絞り込んだデータを、１行ずつ取り出して調べて行きます。
１９０行目「i = i + 1」は、配列の行位置を定めるカウンタ変数ｉを１つ増やします。ｉは１７８行目でLong型で宣言しただけですので、最初は初期値のゼロです。１９０行目を通過することでｉは１から始まります。

１９２～１９４行目のFor～Nextで「１行のデータを先頭列から順番に配列に代入」していきます。
１９２行目「For j = 1 To UBound(buf, 2)」で、カウンタ変数ｊを１から配列の列数だけ回します。
１９３行目「buf(i, j) = r.Cells(1, j)」で、データを配列bufに代入します。この時、左辺の「r.Cells(1, j)」は、図６－１６のように「r（絞り込まれたデータの１行分）に対する、相対的なCell位置」を示しています。今回のテーブルはたまたまA列から始まっていますが、異なる列から始まっているテーブルであっても、相対的な位置なのでコードを調整する必要はありません。

図６－１６

絞り込まれたデータを全て配列buf内に代入したら、１９８行目「SearchList = buf」で、配列bufを関数SearchListの戻り値にセットします。
一方「絞り込みデータはゼロ」の場合は１８５行目でエラーが出ているため変数icntは初期値ゼロのままであり、１８７行目も「ReDim buf(1 To Int(0 / 9), 1 To 9)」となるためReDimの実行を失敗しています。ですので変数bufは初期値のEmptyのままなので、特別なエラー処理をすること無く、そのままEmptyが戻ります。

今回は１８５～１８７行目のように「ループを回す前」にデータを入れる配列のサイズを決めています。一方「ループの中で、配列サイズを１つずつ増やす」方法も良く見掛けます。 例えば１９０行目「i = i + 1」のあとに、「ReDim Preserve buf(1 To wcnt, 1 To i)」などと入れる方法です。但し、ReDimで増やせるのは最終次元（この場合だと列方向）なので、配列の行×列を逆転させる必要があります。 しかし、今回この方法を採用しなかったのは、配列にデータを入れ終えたあと、Traspose関数で行×列を正規の状態に戻した時、なぜか日付型データがString型に変わってしまうからです。 文字列でもシート上のセルに貼り付ければ日付型として見なしてくれると思うのですが、試行段階では、配列データのままでは日付計算がうまく出来ない不具合が発生してしまいました。 今のところ対策方法が見つからないため「事前に配列サイズを定める」方法にしましたが、この方法はあまり見たことが無いので、市場に受け入れてもらえるか少し心配しています。

６－６．列内の最大値を取得

今回システムでは、予約番号を「重複しないユニーク番号」としています。その番号は、図６－１７のTableMax関数を使用して、テーブルの列内最大値を取得し、その値に「＋１」することで求めています。
第一引数としてListObjectを、第二引数として計算をする列名または列位置を受け取ります。

203. '==========　⇩(14)　列内の最大値を取得　============
204. Public Function TableMax(T As ListObject, col As Variant) As Long
205. 　If Not T.ListRows.Count = 0 Then
206. 　　TableMax = WorksheetFunction.Max(T.ListColumns(col).DataBodyRange)
207. 　End If
208. End Function

図６－１７

２０５行目「If Not T.ListRows.Count = 0 Then」は、テーブルにデータが１行も無い時（システムを最初に使う時など）は、２０６行目を実行しないことで、関数のデータ型であるLong型の初期値（＝ゼロ）を戻すことになります。

２０６行目「TableMax = WorksheetFunction.Max(T.ListColumns(col).DataBodyRange)」の右辺は、引数で指定された列のデータ部分（DataBodyRange）をワークシート関数Maxの引数にすることで、最大値を求めています。その最大値はTableMax関数の戻り値に設定しています。

６－７．テーブルへのデータ追加・更新

テーブルにデータを新規追加するのが図６－１８です。第一引数としてListObjectを、第二引数として追加するデータの配列を受取ります。なお追加するデータ配列のサイズは、テーブルの列数と合っていないと、正しくデータが追加されません。

210. '==========　⇩(15)　テーブルへのデータ追加　============
211. Public Sub TableDataIn(T As ListObject, Data As Variant)
212. 　With T.ListRows.Add
213. 　　.Range = Data
214. 　End With
215. End Sub

図６－１８

２１２行目「With T.ListRows.Add」では、テーブルに行を追加します。AddメソッドにPositionパラメータを付けていないので、テーブルの最後尾に行が追加され、その戻り値としてListRowオブジェクトを戻します。
その戻されたListRowオブジェクトに対し、２１３行目「.Range = Data」では「追加された行に、データ配列Dataを貼り付け」ます。

貼り付けるデータ配列Dataは、テーブルのサイズに合っていることが大切です。図６－１９に、テーブルのサイズに合っていない配列データを貼り付けた時の状態を示します。

図６－１９

テーブルサイズより小さい配列を貼り付けた時は、足りなかったセルには「#N/A（値が無い）」というエラー値が入ります。また、大きい配列を貼り付けた時は、余った配列のデータは無視されます。

データを更新するのが、図６－２０です。第一引数にListObjectを、第二引数に「データを更新する列位置または列名」を、第三引数に「書き換える値」を受け取ります。
使い方としては、更新するデータをTableFilter（図６－１２）で絞り込んだ後、colで指定した列位置に対して値Dataを書き込みます。ここでのDataは配列では無く、単一の値です。

217. '==========　⇩(16)　テーブルのデータ更新　============
218. Public Sub TableDataUp(T As ListObject, col As Variant, Data As Variant)
219. 　T.ListColumns(col).DataBodyRange = Data
220. End Sub

図６－２０

２１９行目「T.ListColumns(col).DataBodyRange = Data」で、テーブルの列位置「col」の可視セルに、引数Dataの値を入力しています。

「DVD等の内容･保管場所等管理システム」では、データの書込み行位置を指定することで、データ追加と更新を一つのプロシージャで行う方法を使いましたが、今回はデータ行位置を取得せずに絞り込んだ状態でのデータ更新する方法を採用しました。状況によると思いますが、行の順番は特定できないデータベースの特性を考えると、今回の考え方の方が正しいかもしれません。
また、更新時に複数行のデータを一挙に書き換えられる今回の方法の方が、データベース操作に似ていると思います。

６－８．テーブルのデータ削除

データ削除は、図６－２１のように２段階で行います。

図６－２１

まずTableFilterプロシージャ（図６－１２）で絞り込みを行います。その絞りこまれたセル範囲を取得します（図６－２１の左側）。
その後フィルターを解除（TableFilterOffプロシージャ（図６－１３））し、取得したセル範囲（Rangeオブジェクト）に対して「Deleteメソッド」でデータ削除します。
この二度手間とも思える手法により「テーブル内の行のみを削除」することが出来ます。

まず、絞り込んだデータのセル範囲を取得する関数プロシージャが図６－２２です。引数としてListObjectを受取ります。

222. '==========　⇩(17)　絞り込んだデータのセル範囲を取得　============
223. Public Function SelectRange(T As ListObject) As Range
224. 　On Error Resume Next
225. 　　Set SelectRange = T.DataBodyRange.SpecialCells(xlCellTypeVisible)
226. 　On Error GoTo 0
227. End Function

図６－２２

２２５行目「Set SelectRange = T.DataBodyRange.SpecialCells(xlCellTypeVisible)」で、絞り込んだデータ部分（DataBodyRangeを指定しているため、見出し部分は除く）のRangeオブジェクトを、SelectRange関数の戻り値にセットします。
但し、絞り込みの結果「可視セルのデータ行が無い」場合には「.SpecialCells(xlCellTypeVisible)」の部分でエラーが発生してしまいますので、２２４行目「On Error Resume Next」でエラー処理しています。「可視セルのデータ行が無い」場合の関数の戻り値は、Range型の初期値のNothingとなります。

絞り込み解除後、SelectRange（図６－２２）で取得したセル範囲を削除するのが図６－２３です。引数として、削除するセル範囲を受取ります。

229. '==========　⇩(18)　指定セル範囲の削除　============
230. Public Sub TableDataDel(r As Range)
231. 　If r Is Nothing Then Exit Sub
233. 　r.Delete
234. End Sub

図６－２３

但し受け取ったセル範囲rが「Nothing（絞り込んだ結果１行も残らず、SelectRange関数がNothingを戻してきた）」の場合は削除が出来ないので、まず２３１行目「If r Is Nothing Then Exit Sub」で、処理を中止します。
セル範囲が存在する時には２３３行目「r.Delete」を実行し、（絞り込んだテーブルの範囲を）削除します。

テーブルでのデータ削除として、他サイトで多く紹介されている手法は、TableFilter（図６－１２）で削除する行を絞り込んだ後、図６－２４のように「リストオブジェクト.DataBodyRange.EntireRow.Delete」で「行全体を削除」する手法です。 '==========　⇩(19)　行削除を使う手法　============ Public Sub TableDataDel2(T As ListObject) 　T.DataBodyRange.EntireRow.Delete End Sub 図６－２４ 確かにこの手法だと、テーブルを絞り込んだままでもDelete出来ますし、データ更新の「TableDataUp（図６－２０）」とほぼ同じ構文となりますので、理解もし易いと思います。 しかし、行全体を削除してしまうため、同じシート上の他のテーブルに影響を与える可能性があります。ListObjectは１つのシート上に複数のテーブルを置くことが可能と謳われていますが、それが出来なくなることになります。 そこで今回システムでは、「絞り込み時のセル範囲を取得」し「絞り込みを解除」した後「取得したセル範囲を削除」する方法を取りました。これならテーブル以外に影響を与えることが無い反面、手数が１つ増えるデメリットがあります。 ただし、同一シート上の複数のテーブルを同時に絞り込みすることが出来ないのも事実なので、事実上は「１シートに１テーブル」となるのであれば「EntireRow.Delete」を使うのも実務上OKなのかもしれません。

６－９．貸出表データの更新

テーブルのデータを使って、貸出表を作成するのが図６－２５です。

241. '==========　⇩(20)　貸出表データの更新　============
242. Public Sub T1make()
243. 　Dim buf As Variant 　　　 '←絞り込み済データの配列
244. 　Dim i As Long 　　　　　 '←カウンタ変数（貸出表の行数）
245. 　Dim j As Long 　　　　　 '←カウンタ変数（同じ行内の予約番号の数）
247. 　Application.ScreenUpdating = False
248. 　　T_1.ClearContents
250. 　　Call TableFilterOff(T_2)
251. 　　Call TableFilter(T_2, "startD", "<=" & DispDateS.Value + DispDateW - 1)
252. 　　Call TableFilter(T_2, "endD", ">=" & DispDateS.Value)
254. 　　For i = 1 To T_1.Rows.Count
255. 　　　Call TableFilter(T_2, "Kno", "=" & T_1.Parent.Cells(T_1.Rows(i).Row, T1Kno))
256. 　　　Call TableFilter(T_2, "Bname", "=" & T_1.Parent.Cells(T_1.Rows(i).Row, T1Bname))
257. 　　　buf = SearchList(T_2)
259. 　　　If Not IsEmpty(buf) = True Then
260. 　　　　For j = 1 To UBound(buf, 1)
261. 　　　　　T1CellSelect(CDate(buf(j, 7)), CDate(buf(j, 8)), i) = buf(j, 9) & buf(j, 1)
262. 　　　　Next j
263. 　　　End If
264. 　　Next i
266. 　　Call TableFilterOff(T_2)
268. 　Application.ScreenUpdating = True
269. End Sub

図６－２５

まず、コードの流れを図６－２６に示します。

図６－２６

データが書き出される貸出表の日付は、このプロシージャが流れている間は固定ですので、まず「貸出表の表示期間で絞り込み」をします。その上で、貸出表の左側に並んでいる「備品リスト」で１行ずつ絞り込みます。
この２種類で絞りこまれたものは、貸出表の１行分に表示されるデータという事になります。

このデータを１つずつ処理していきます。
まずデータの開始日・終了日を取得し、そのデータをT1CellSelect関数プロシージャに送ります。T1CellSelect関数の中では貸出表の中での開始日・終了日の相対位置を計算します。そのT1CellSelect関数から得られたセル範囲に予約番号を書き込みます。
１行分の処理が完了したら、貸出表の一つ下の行に移動し、備品リストの最下行まで同じ処理を繰り返します。

貸出表に書き込んだ予約番号の先頭には、一緒に状態記号（Y＝予約中、K＝貸出中、H=返却済）の記号も付けられています。その記号により、貸出表の条件付き書式でセル背景色が変更される事で、ガントチャート風に見える事になります。

２４８行目「T_1.ClearContents」では、まず貸出表を全てクリアしています。
２５０行目「Call TableFilterOff(T_2)」では、テーブルの絞り込みを念の為解除しています。

２５１～２５２行目では、貸出表への表示の対象となるデータを「開始日・終了日」から絞り込みます。その方法は図６－２７のように、「貸出表の初日」「貸出表の最終日」「データの開始日」「データの終了日」との関係で求めることが出来ます。

図６－２７

図６－２７から分かる様に、以下の２つの関係式が同時に成り立つものが「貸出表に表示される対象（図６－２７の太い矢印）」となります。
　・「データの開始日」＜＝「貸出表の最終日」
　・「データの終了日」＞＝「貸出表の初日」
これをコードにすると、
２５１行目「Call TableFilter(T_2, "startD", "<=" & DispDateS.Value + DispDateW - 1)」
２５２行目「Call TableFilter(T_2, "endD", ">=" & DispDateS.Value)」
を同時に絞り込むことになります。
ちなみに「DispDateS.Value」は貸出表の初日、「DispDateS.Value + DispDateW - 1」が貸出表の最終日です。これは、図６－５の４８～４９行目で設定されています。

次に、貸出表の備品リストを上から１行ずつ絞りこんでいきます。
２５４行目「For i = 1 To T_1.Rows.Count」で、カウンタ変数ｉを１から備品の行数（＝貸出表T_1の行数）だけ回します。
今回システムでは、備品を一意に指定するのは「備品名」＋「備品の管理番号」としました。ですのでその両方で絞り込むことが必要です。

この「備品名」の位置は、図６－１の２９行目で「T1Bname」と定数設定（サンプルファイルでは値2）しています。また２つ目の「管理番号」は３０行目で「T1Kno」と定数設定（値3）しています。
なお、この「T1Bname」「T1Kno」の値は「（貸出表がどこに表示されているかは関係無く）絶対的な列位置」です。
一方、２５４行目のカウンタ変数ｉは「貸出表T_1の中のｉ行目」となりますので「相対的な行位置」です。
絶対的な位置か相対的な位置か、どちらかに統一しないと正しいセル位置を取得できません。今回は絶対的位置に揃えます。

「貸出表T_1のｉ行目」を絶対的位置に変換するには、「.Row」プロパティを使い「T_1.Rows(i).Row」となります。
また、貸出表のシート位置ですが、図６－１の２７行目の「T1sh」定数（サンプルファイルでは、文字列で"Sheet1"）が使えそうですがPrivate指定ですので使えません。そこで貸出表の範囲（Range）T_1の「親（Sheet）」を求め、「T_1.Parent」をシート位置として使います。

以上により「備品名」で絞り込むコードは、２５５行目「Call TableFilter(T_2, "Kno", "=" & T_1.Parent.Cells(T_1.Rows(i).Row, T1Kno))」となります。
また「備品の管理番号」も同様に、２５６行目「Call TableFilter(T_2, "Bname", "=" & T_1.Parent.Cells(T_1.Rows(i).Row, T1Bname))」となります。

以上により、貸出表の１行分に表示されるデータが絞りこまれましたので、２５７行目「buf = SearchList(T_2)」で、テーブルからデータを収集します。このデータ内には複数のデータ（＝貸出表表示の２週間内に複数の予約等）が入っている可能性があります。
まず２５９行目「If Not IsEmpty(buf) = True Then」で、データが空（貸出表表示の２週間内には予約等が無い）の場合を除きます。その上で２６０行目「For j = 1 To UBound(buf, 1)」でカウンタ変数ｊをデータの行数分だけ回し、２６１行目「T1CellSelect(CDate(buf(j, 7)), CDate(buf(j, 8)), i) = buf(j, 9) & buf(j, 1)」で、対応するセル範囲に予約番号等を書き込みます。

ここで使用している「T1CellSelect関数」は、図６－２８のように「データの開始日・終了日」及び「貸出表内での行位置」を引数に与えると、「貸出表内でのセル位置」を戻してくれるようにしています。


図６－２８

この「T1CellSelect関数」の戻り値（Range型）に「状態を表す記号＋予約番号（ buf(j, 9) & buf(j, 1) ）」を書き込むことで、貸出表にデータが並びます。この作業を貸出表の行数分だけ実施します。

最後に２６６行目「Call TableFilterOff(T_2)」で、テーブルの絞り込みを解除します。

６－１０．開始終了日から貸出表の該当セル範囲を出力

図６－２５の２６１行目、および図６－３０の３１３行目から呼び出される「T1CellSelect関数」が図６－２９です。
項目の開始日・終了日が分かっている場合に「貸出表内での絶対的セル位置」を戻すものです。
第一引数の項目の「開始日（StartD）」を、第二引数に「終了日（EndD）」を、第三引数に「貸出表T_1範囲に対する相対的な行位置」を受け取ります。

271. '==========　⇩(21)　開始終了日から貸出表の該当セル範囲を出力　============
272. Private Function T1CellSelect(startD As Date, endD As Date, r As Long) As Range
273. 　Dim startR As Integer 　　　 '←貸出表上の開始列位置
274. 　Dim endR As Integer 　　　 '←貸出表上の終了列位置
276. 　Select Case startD
277. 　　Case Is <= DispDateS.Value
278. 　　　startR = 1
279. 　　Case Else
280. 　　　startR = startD - DispDateS.Value + 1
281. 　End Select
283. 　Select Case endD
284. 　　Case Is >= DispDateS.Value + DispDateW - 1
285. 　　　endR = DispDateW
286. 　　Case Else
287. 　　　endR = endD - DispDateS.Value + 1
288. 　End Select
290. 　Set T1CellSelect = Range(T_1.Cells(r, startR), T_1.Cells(r, endR))
291. End Function

図６－２９

２７６～２８１行目は「貸出表上の開始列位置」を計算しています。そのため引数の開始日（startD）の値を２７６行目「Select Case startD」で調べます。なお貸出表の初日は、変数DispDateS.Valueで求めることができます。
２７７行目「Case Is <= DispDateS.Value」は、「貸出表の初日より、開始日の方が前」の時です。図６－２７で言えば②の状態です。この場合は、貸出表の先頭からセルが始まりますので、２７８行目「startR = 1」で「貸出表上の開始列位置＝１」にセットします。
その他の場合（図６－２７で言えば③④の状態）は、初日と開始日の差分だけ離れた位置にしますので、２８０行目「startR = startD - DispDateS.Value + 1」で、「貸出表上の開始列位置＝ 開始日－初日＋１」となります。

２８３～２８８行目は「貸出表上の終了列位置」を計算しています。そのため引数の終了日（endD）の値を２８３行目「Select Case endD」で調べます。なお貸出表の最終日は「貸出日初日＋貸出表の幅 －１」で求められ、コードとしては「DispDateS.Value＋DispDateW - 1」となります。

２８４行目「Case Is >= DispDateS.Value + DispDateW - 1」は、「貸出日の最終日より、終了日の方が後」の時です。図６－２７で言えば④の状態です。この場合は、貸出表の最終列で終わりますので、２８５行目「endR = DispDateW」で「貸出表上の終了位置＝貸出表の最終列」にセットします。
その他の場合（図６－２７で言えば②③の状態）は、初日と終了日の差分だけ離れた位置にしますので、２８７行目「endR = endD - DispDateS.Value + 1」で「貸出表上の終了列位置＝ 終了日－初日＋１」となります。

ここまでで、貸出表内の開始列と終了列が計算できました。行位置は第三引数で受け取った「r」で、行・列とも貸出表T_1を基準とした相対的な位置になります。
関数の戻り値には「絶対的な位置」を出力する必要があるので、開始セル位置は「T_1.Cells(r, startR)」、終了セル位置は「T_1.Cells(r, endR)」とし、それらをセル範囲を示すRangeの開始セル位置・終了セル位置に設定します。これが２９０行目「Set T1CellSelect = Range(T_1.Cells(r, startR), T_1.Cells(r, endR))」です。

なお、２９０行目は「Set T1CellSelect = T_1.Range(Cells(r, startR), Cells(r, endR))」としても同じ結果が得られます。理解のし易い方で良いと思います。

６－１１．予約番号から貸出表の該当セル範囲を出力

図６－７の８２行目、図６－８の９９行目、図６－９の１１７行目から呼び出される「YnoRange関数」が図６－３０です。
項目の予約番号が分かっている場合に「貸出表内での絶対的セル位置」を戻すものです。

第一引数に「予約番号Yno」を、第二引数に「絶対的な行位置」を受け取ります。上記T1CellSelect関数の場合は「相対的な行位置」を引数としたのですが、このYnoRange関数は「ユーザーが選択したセル位置にあるデータ範囲を戻す」目的で作ったので 、絶対的行位置としています。

293. '==========　⇩(22)　予約番号から貸出表の該当セル範囲を出力　============
294. Private Function YnoRange(Yno As Long, r As Long) As Range
295. 　Dim buf As Variant 　　　 '←取得したテーブルデータの配列
297. 　Application.ScreenUpdating = False
298. 　　Call TableFilterOff(T_2)
299. 　　Call TableFilter(T_2, "Yno", "=" & Yno)
300. 　　buf = SearchList(T_2)
301. 　　Call TableFilterOff(T_2)
303. 　　If IsEmpty(buf) = True Then
304. 　　　MsgBox "予約番号(" & Yno & ")が存在しません。"
305. 　　　Exit Function
306. 　　End If
307. 　　If UBound(buf, 1) > 1 Then
308. 　　　MsgBox "重複データ(" & buf(1, 1) & ")が存在します。"
309. 　　　Exit Function
310. 　　End If
312. 　　r = r - T_1.Row + 1
313. 　　Set YnoRange = T1CellSelect(CDate(buf(1, 7)), CDate(buf(1, 8)), r)
314. 　Application.ScreenUpdating = True
315. End Function

図６－３０

２９７行目「Application.ScreenUpdating = False」は、この関数内でテーブルの絞り込み・絞り込み解除を行った時のExcel画面のチラつきを防止するため、画面更新を停止させています。

２９８行目「Call TableFilterOff(T_2)」で、念の為にテーブルの絞り込み解除をします。
２９９行目「Call TableFilter(T_2, "Yno", "=" & Yno)」で、予約番号（Yno）で絞り込みを行います。
３００行目「buf = SearchList(T_2)」で、絞り込んだデータを取得し、bufに代入します。データがあれば配列に、無ければEmptyになります。
３０１行目「Call TableFilterOff(T_2)」でテーブルの絞り込み解除をします。

３０３行目「If IsEmpty(buf) = True Then」は、データが無かった場合（bufがEmpty）は、あるべき予約番号（Yno）が無いのは異常ですので、３０４行目「MsgBox "予約番号(" & Yno & ")が存在しません。"」でコメントを出し、３０５行目「Exit Function」で、この関数を抜け出します。関数の戻り値はRange型ですので、Nothingが戻ることになります。

３０７～３１０行目は「予約番号が２つ取得された」時の処理です。ユニーク番号であるべき予約番号（Yno）が複数あることは、通常ではあり得ませんが、テーブルの手動での編集でミスをした時には発生する可能性があります。
３０７行目「If UBound(buf, 1) > 1 Then」で、データが複数存在するかを調べ、複数の場合は３０８行目「MsgBox "重複データ(" & buf(1, 1) & ")が存在します。"」でコメントを出します。コメント内には、重複している予約番号を差し込みます。
そして３０９行目「Exit Function」で関数を抜け出します。

データが単一で得られた時は、３１３行目「Set YnoRange = T1CellSelect(CDate(buf(1, 7)), CDate(buf(1, 8)), r)」で、図６－２９のT1CellSelect関数を呼び出して「貸出表のセル位置」を取得し、それをYnoRange関数の戻り値にします。
しかし、YnoRange関数の第二引数で受け取った行位置（r）は絶対的行位置であり、T1CellSelect関数へ渡す第三引数（r）は貸出表に於ける相対的行位置です。この変換のため、３１２行目「r = r - T_1.Row + 1」で、行位置を絶対位置→相対位置に変換した後、T1CellSelect関数に引数を渡しています。

なお、T1CellSelect関数は開始日・終了日からセル位置を割り出し、YnoRange関数は予約番号から割り出すと説明しましたが、「T1CellSelect関数」と「YnoRange関数」は、機能が被っているような気がします。と言って、貸出表を作る（T1make）の中でYnoRange関数を使ってしまうとテーブルの絞り込みがメチャクチャになってしまうので、今のままでは統一できません。
もう少し整理する必要はありそうです。

７．予約用ユーザーフォーム(UserForm1)

７－１．フォーム上レイアウト

予約用フォームは図７－１の様にレイアウトしました。

図７－１

ユーザーが貸出表内をセル選択した位置を元にして、以下の情報が分かります。
　・セル選択範囲の行位置　　→「備品名（Label1）」「備品管理番号（Label2）」
　・セル選択範囲の左端列位置→「開始日（Label3）」
　・セル選択範囲の右端列位置→「終了日（Label4）」
この情報をフォームのLabelに表示し、ユーザーが入力する情報「氏名」「部署」「取消時のパスワード」をTextBoxに入れるようにします。
また、予約実行するためのCommandButton1と予約をキャンセルするためのCommandButton2を一番下に配置します。

７－２．フォームモジュール

７－２－１．起動時設定

UserForm1は、図６－６の６５行目で起動されます。起動時に、ユーザーがセル選択した位置から「備品名」「管理番号」「開始日」「終了日」を計算し、フォームの各LabelのCaptionに設定します。また、ボタン・テキストボックスの設定も行います。

316. '==========　⇩(23)　起動時設定　============
317. Private Sub UserForm_Initialize()
318. 　Me.Caption = "予約"
320. 　Me.Label1.Caption = Cells(Selection.Row, T1Bname).Value 　　　　　　　 '←備品名
321. 　Me.Label2.Caption = Cells(Selection.Row, T1Kno).Value 　　　　　　　　　 '←備品管理番号
322. 　Me.Label3.Caption = Cells(DispDateS.Row, Selection.Column).Value 　　　 '←開始日
323. 　Me.Label4.Caption = Cells(DispDateS.Row, Selection(Selection.Count).Column).Value 　　　 '←終了日
325. 　Me.CommandButton2.Cancel = True 　　　　　　　 '←ESCキーでCancel
326. 　Me.TextBox3.IMEMode = fmIMEModeDisable 　　　 '←PW欄は半角にする
327. End Sub

図７－２

３１８行目「Me.Caption = "予約"」は、ダイアログのタイトル文字列を「予約」にします。
３２０～３２３行目は、ユーザーがセル選択した範囲から得られる情報（図７－３）をフォーム上のLabelに書き込みます。

図７－３

３２０行目「Me.Label1.Caption = Cells(Selection.Row, T1Bname).Value」では、備品名をLabel1に書き込んでいます。
行位置はセル選択した行位置、列位置は定数T1Bname（サンプルファイルでは、値2）のセル値を指します。
３２１行目「Me.Label2.Caption = Cells(Selection.Row, T1Kno).Value」では、管理番号をLabel2に書き込んでいます。
行位置はセル選択した行位置、列位置は定数T1Kno（サンプルファイルでは、値3）のセル値を指します。
３２２行目「Me.Label3.Caption = Cells(DispDateS.Row, Selection.Column).Value」では、開始日をLabel3に書き込んでいます。行位置は日付行（DispDateS.Row）の行位置、列位置はセル選択範囲の先頭セルの列位置のセル値を指します
３２３行目「Me.Label4.Caption = Cells(DispDateS.Row, Selection(Selection.Count).Column).Value」では、終了日をLabel4に書き込んでいます。行位置は日付行（DispDateS.Row）の行位置、列位置はセル選択範囲の最終セルの列位置のセル値を指します

３２５行目「Me.CommandButton2.Cancel = True」は、CommandButton2のCancelプロパティをTrueにし、ユーザーがESCキーを押した時にCommandButton2をクリックしたことにします。
３２６行目「Me.TextBox3.IMEMode = fmIMEModeDisable」は、パスワードを入力するTextBox3は、半角のみとするため日本語IMEをOFFにします。但し、コピペをされると全角も入力が出来てしまいます。

７－２－２．予約実行

ダイアログの「OK」ボタンを押した時に実行されるのが、図７－４です。

329. '==========　⇩(24)　OKボタン　============
330. Private Sub CommandButton1_Click()
331. 　Dim Data As Variant 　　　 '←挿入データの配列
332. 　Dim MaxNo As Long 　　　 '←テーブルのユニーク番号
334. 　If Trim(Me.TextBox1.Text) = "" Then
335. 　　MsgBox "氏名は入力必須です。"
336. 　　Exit Sub
337. 　End If
339. 　MaxNo = TableMax(T_2, "Yno") + 1
341. 　ReDim Data(1 To T_2.HeaderRowRange.Count)
342. 　Data(1) = MaxNo 　　　　　　　　　　　 '←Yno
343. 　Data(2) = Me.Label1.Caption 　　　　　 '←Bname
344. 　Data(3) = Me.Label2.Caption 　　　　　 '←Kno
345. 　Data(4) = Me.TextBox1.Text 　　　　　 '←name
346. 　Data(5) = Me.TextBox2.Text 　　　　　 '←Dept
347. 　Data(6) = Me.TextBox3.Text 　　　　　 '←PW
348. 　Data(7) = CDate(Me.Label3.Caption) 　 '←StartD
349. 　Data(8) = CDate(Me.Label4.Caption) 　 '←EndD
350. 　Data(9) = "Y" 　　　　　　　　　　　　 '←Status
352. 　Call TableDataIn(T_2, Data)
354. 　Call T1make
355. 　Unload Me
356. End Sub

図７－４

ユーザーが入力出来るのは「氏名」「部署」「パスワード」ですが、今回必須入力としているのは「氏名」のみです。ですので、３３４～３３７行目では「氏名が入力されているか」を確認しています。
３３４行目「If Trim(Me.TextBox1.Text) = "" Then」で、両端のスペースを削除した文字列が「""（長さゼロの文字列）」か否かで入力有無を判断しています。
３３５行目「MsgBox "氏名は入力必須です。"」でコメントを出し、３３６行目「Exit Sub」で処理を中止しています。

氏名が入力されていた場合は、３３９行目「MaxNo = TableMax(T_2, "Yno") + 1」で、図６－１７のTableMax関数を呼び出して「予約番号の最大値」を取得します。第一引数にはデータテーブルの「T_2」ListObjectを、第二引数には「最大値を珪砂する列名＝"Yno"」を指定します。
なお、万一テーブルが絞りこまれた状態でTableMax関数を実行しても、正しい最大値が取得できるため、TableFilterOff（図６－１３）は事前実行をしていません。
このTableMaxで得られた「予約番号の最大値」に「＋１」をすることで、ユニーク番号としています。

３４１行目「ReDim Data(1 To T_2.HeaderRowRange.Count)」では、テーブルに追加するデータの配列サイズを定めています。図６－１９で示したように「テーブルの横にピッタリ」するサイズの配列が必要なので「T_2.HeaderRowRange.Count」とテーブル横サイズを取得し、設定しています。

３４２～３５０行目は、その配列にデータを１つずつ代入しています。順番はテーブルの順番と合わせます。
３４２行目「Data(1) = MaxNo」は、３３９行目で得たユニーク番号を代入します。
３４３～３４４行目は、備品名・備品の管理番号を、ダイアログのLabel値から代入します。
３４５～３４７行目は、ユーザーが入力した値を、TextBox値から代入します。
３４８～３４９行目は、開始日・終了日をダイアログのLabel値から代入します。その際「CDate関数」で日付型に修正していますが、特に「日付が文字列としてテーブルに貼り付く」ような現象は発生しません。「日付を渡した」という気持ちだけです。
３５０行目「Data(9) = "Y"」は、状態として「Y」の文字列を代入します。今回システムでは「予約（Y）」からスタートし、管理者によって「貸出（K）」「返却（H）」と進むことにしています。

配列が完成したら、３５２行目「Call TableDataIn(T_2, Data)」で、図６－１８を呼び出し、テーブルにデータを挿入します。第一引数にはテーブルである「T_2」ListObject、第二引数には、３４２～３５０行目で値代入した配列Dataを渡します。

データ挿入したら、３５４行目「Call T1make」で図６－２５を呼び出し、貸出表の更新します。これにより３５２行目でテーブルに挿入したデータが貸出表に反映されます。
最後に、３５５行目「Unload Me」で、ダイアログを閉じます。

ダイアログの「Cancel」ボタンをクリックした時に呼び出されるのが図７－５です。
単にダイアログをとじます。テキストボックスに何か入力中であっても、無視して閉じています。

358. '==========　⇩(25)　Cancelボタン　============
359. Private Sub CommandButton2_Click()
360. 　Unload Me
361. End Sub

図７－５

８．予約取消用ユーザーフォーム(UserForm2)

８－１．フォーム上レイアウト

予約を取り消すためのフォームは、図８－１のようにしました。

図８－１

テーブルに登録されている情報をダイアログ上にLabelとして表示し、取消のためのパスワードだけは本人確認のために入力用TextBoxを用意します。なお、今回は「貸出中の項目をクリックした時でも、このダイアログが表示されてしまう」ために、予約用ダイアログ（図７－１）では「予約期間」と表示した文字列の部分は、Label8として状況に合わせた表示が出来るようにしています。
「OKボタン」に相当するCommandButton1も、状況に合わせて変化させるため、表面文字列はマクロ側から書き込みます。

８－２．フォームモジュール

貸出表上部の「取消」ボタンをクリックすることで、図６－７の「Torikeshiプロシージャ」が呼び出され、その中の８４行目で「UserForm2 内のUFstartプロシージャ」が呼び出されることで、このフォームは起動します。
呼び出す際に「予約番号」を引数として渡されますので、その番号に基づいた設定をします。

８－２－１．初期設定等

フォームモジュール内で共通して使用する変数の宣言が図８－２です。

363. '==========　⇩(26)　フォームレベル変数宣言　============
364. Dim Yno As Long 　　　 '←予約番号
365. Dim PW As String 　　　 '←予約時パスワード

図８－２

３６４行目「Dim Yno As Long」は、図６－７「Torikeshiプロシージャ」から引数として与えられた「予約番号」をフォーム内で共通して使用するための変数です。値はUFstartプロシージャ内の３７９行目で代入されます。
３６５行目「Dim PW As String」は、予約番号に紐付いた「予約時に設定したパスワード」です。値はUFstartプロシージャ内の４０５行目で代入され、取消処理に入る際の「本人確認としてのチェック」に使用されます。

フォームを起動する際に、最初に呼び出されるイベントプロシージャが図８－３です。

367. '==========　⇩(27)　フォーム初期設定　============
368. Private Sub UserForm_Initialize()
369. 　Me.Caption = "予約の取り消し"
370. 　Me.CommandButton2.Cancel = True
371. 　Me.TextBox1.IMEMode = fmIMEModeDisable
372. End Sub

図８－３

３６９行目「Me.Caption = "予約の取り消し"」では、ダイアログのタイトルの文字を設定しています。
３７０行目「Me.CommandButton2.Cancel = True」では、ユーザーがESCキーを押した時はCancelボタン（CommandButton2）が押されたことにし、ユーザー操作を補助しています。
３７１行目「Me.TextBox1.IMEMode = fmIMEModeDisable」では、パスワードを入力するTextBox1を入力する際は、日本語IMEをOFFにし、半角のみで入力できるようにしています。これは、予約用フォームの図７－２の３２６行目と合わせています。

８－２－２．フォーム準備・起動

図６－７のTorikeshiプロシージャの８４行目から呼び出されるのが、図８－４です。引数として「予約番号」を受取ります。

374. '==========　⇩(28)　フォーム準備・起動　============
375. Public Sub UFstart(Y As Long)
376. 　Dim buf As Variant 　　　 '←予約番号Ynoに基づいた情報を入れる配列
377. 　Dim Status As String 　　 '←予約番号Ynoの現在の状態
379. 　Yno = Y
380. 　Application.ScreenUpdating = False
381. 　　Call TableFilterOff(T_2)
382. 　　Call TableFilter(T_2, "Yno", CStr(Yno))
383. 　　buf = SearchList(T_2)
384. 　　Call TableFilterOff(T_2)
385. 　Application.ScreenUpdating = True
387. 　If IsEmpty(buf) = True Then
388. 　　MsgBox "予約番号(" & Yno & ")が存在しません。"
389. 　　Exit Sub
390. 　End If
392. 　If UBound(buf, 1) > 1 Then
393. 　　MsgBox "重複データ(" & buf(1, 1) & ")が存在します。"
394. 　　Exit Sub
395. 　End If
397. 　Me.Label1.Caption = buf(1, 1) 　　　 '←Yno
398. 　Me.Label2.Caption = buf(1, 2) 　　　 '←Bname
399. 　Me.Label3.Caption = buf(1, 3) 　　　 '←Kno
400. 　Me.Label4.Caption = buf(1, 7) 　　　 '←StartD
401. 　Me.Label5.Caption = buf(1, 8) 　　　 '←EndD
402. 　Me.Label6.Caption = buf(1, 4) 　　　 '←name
403. 　Me.Label7.Caption = buf(1, 5) 　　　 '←Dept
405. 　PW = buf(1, 6)
406. 　Status = buf(1, 9)
408. 　Select Case Status
409. 　　Case "Y"
410. 　　　Me.Label8.Caption = "予約期間"
411. 　　　Me.CommandButton1.Caption = "削除"
412. 　　Case Else
413. 　　　Me.Label8.Caption = "貸出期間"
414. 　　　Me.CommandButton1.Caption = "操作不可"
415. 　　　Me.CommandButton1.Enabled = False
416. 　　　Me.TextBox1.Enabled = False
417. 　　　Me.TextBox1.Text = "取消不可の項目です"
418. 　End Select
420. 　Me.Show
421. End Sub

図８－４

３７９行目「Yno = Y」では、引数として受け取った「予約番号」をフォームモジュール内で共通使用できるようにモジュールレベル変数Ynoに値を代入します。

３８１～３８４行目ではテーブルの絞り込み・解除をするので画面チラツキを抑えるため、３８０行目「Application.ScreenUpdating = False」で画面更新を停止させます。
３８１行目「Call TableFilterOff(T_2)」で、念の為「絞り込み解除」をします。
３８２行目「Call TableFilter(T_2, "Yno", CStr(Yno))」で、引数で得た「予約番号」で絞り込みをします。
３８３行目「buf = SearchList(T_2)」で、絞り込んだデータを取得し、配列bufに代入します。
３８４行目「Call TableFilterOff(T_2)」で、絞り込みを解除します。

３８７行目「If IsEmpty(buf) = True Then」では、配列bufが空（Empty）か否かを調べています。空と言うことは、３８２行目の「絞り込みの結果、何も得られなかった」という事ですから、テーブルのデータの中に「引数で渡された予約番号が存在しない」という事になります。
この原因としては、貸出表上のデータをユーザーが編集してしまった等が考えられますが、この状態では予約情報の表示も出来ませんので、３８８行目「MsgBox "予約番号(" & Yno & ")が存在しません。"」でコメントを出し、３８９行目「Exit Sub」で予約取消処理を中止します。

逆に３９２行目「If UBound(buf, 1) > 1 Then」では、配列bufが複数行か否かを調べています。ユニークなはずの予約番号が複数存在する原因は、テーブルのデータを編集したり、人手でデータ追加した等が考えられます。しかし、どのデータが正しいのかがこの時点では不明なので、３９３行目「MsgBox "重複データ(" & buf(1, 1) & ")が存在します。"」でコメントを出し、３９４行目「Exit Sub」で予約取消処理を中止します。

予約番号データが単一で取得できた時には、３９７～４０３行目で情報をフォーム内のLabelに代入しますが、パスワードだけは４０５行目「PW = buf(1, 6)」でモジュールレベル変数に代入します。
また、状態（Status）も４０６行目「Status = buf(1, 9)」で変数に代入し、以降で「状態に合ったフォーム」を作ります。

状態は今回システムでは３種です。それぞれの状態の時の「予約取消のフォーム」を考えると、以下の様になります。

状態	開始日～終了日	実行する事	パスワード
予約(Y)	予約期間	予約取消	入力可
貸出(K)	貸出期間(貸出中)	無し	入力の意味無し
返却(H)	貸出期間(貸出済)	無し	入力の意味無し

図８－５

これをSelect Caseで場合分けしたのが４０８～４１８行目です。
まず「予約（Y）」の場合は、４１０行目「Me.Label8.Caption = "予約期間"」で、開始日・終了日のタイトルを「予約期間」とします。また、４１１行目「Me.CommandButton1.Caption = "削除"」で実行ボタンの表示を「削除」とします。
（「取消」という表現にしなかったのは「実行を取り消す（≒Cancel）」と思われたくなかったからです。）

次に「貸出(K)」と「返却(H)」は、ほぼ一緒で良いと判断し「Case Else」で括りました。
４１３行目「Me.Label8.Caption = "貸出期間"」は、開始日・終了日のタイトルを「貸出期間」とします。
４１４行目「Me.CommandButton1.Caption = "操作不可"」は、実行ボタンは使えないという意味の「操作不可」とします。
４１５行目「Me.CommandButton1.Enabled = False」は、実行ボタンを操作出来ないようにします。４１４～４１５行目をまとめて「Me.CommandButton1.Visible = False」と「実行ボタンを無くす」のでも良いと思います。
４１６行目「Me.TextBox1.Enabled = False」は、パスワード入力用のTextBox1を操作不可にします。
４１７行目「Me.TextBox1.Text = "取消不可の項目です"」は、パスワード欄が使えないことを表示します。

これでフォームの準備が整いましたので、４２０行目「Me.Show」でフォームを表示します。

８－２－３．予約取消の実行

ダイアログの「削除」ボタンをクリックした時に呼び出されるのが、図８－６です。

423. '==========　⇩(29)　予約取消の実行　============
424. Private Sub CommandButton1_Click()
425. 　Dim r As Range 　　　 '←絞り込んだセル範囲
427. 　If Not Me.TextBox1.Value = PW Then
428. 　　MsgBox "パスワードが違います"
429. 　　Exit Sub
430. 　End If
432. 　Application.ScreenUpdating = False
433. 　　Call TableFilterOff(T_2)
434. 　　Call TableFilter(T_2, "Yno", CStr(Yno))
435. 　　Set r = SelectRange(T_2)
436. 　　Call TableFilterOff(T_2)
438. 　　Call TableDataDel(r)
439. 　Application.ScreenUpdating = True
441. 　Call T1make
442. 　Unload Me
443. End Sub

図８－６

まず、４２７行目「If Not Me.TextBox1.Value = PW Then」で、TextBoxに入力したパスワードと、予約時に登録したパスワードが同じか否かを確認しています。このパスワードチェック機能が無いと「誰でも予約が取り消せる」ことになり、悪く言えば「自分が借りたいから、他人の予約を消す」ことも出来てしまうことになります。
パスワードが異なる時は、４２８行目「MsgBox "パスワードが違います"」でコメントを出し、４２９行目「Exit Sub」で取消処理を中止します（取消ダイアログは消えません）。

４３３～４３８行目では、テーブルの絞り込み・解除をするので画面チラツキを抑えるため、４３２行目「Application.ScreenUpdating = False」で画面更新を停止させます。
４３３行目「Call TableFilterOff(T_2)」で、念の為「絞り込み解除」をします。
４３４行目「Call TableFilter(T_2, "Yno", CStr(Yno))」で、「予約番号」で絞り込みをします。
４３５行目「Set r = SelectRange(T_2)」で図６－２２のSelectRange関数を呼び出します。絞り込んだデータの「セル範囲（Rangeオブジェクト）」を取得し、変数rに代入します。
４３６行目「Call TableFilterOff(T_2)」で、絞り込みを解除します。

絞り込みを解除した後、４３８行目「Call TableDataDel(r)」で図６－２３のTableDataDelプロシージャを呼び出し、４３５行目で取得したセル範囲を削除します。

データ削除が完了したら、４４１行目「Call T1make」で図６－２５を呼び出し、貸出表の更新をします。これにより予約取消が貸出表に反映されます。最後に４４２行目「Unload Me」でダイアログを閉じます。

ダイアログの「Cancel」ボタンをクリックした時に呼び出されるのが図８－７です。単にダイアログを閉じるだけで、パスワード欄に入力途中でも無視をします。

445. '==========　⇩(30)　予約取消のキャンセル　============
446. Private Sub CommandButton2_Click()
447. 　Unload Me
448. End Sub

図８－７

９．確認用ユーザーフォーム(UserForm3)

９－１．フォーム上レイアウト

予約等の情報を確認するフォームは、図９－１のようにしました。

図９－１

「予約取消」のフォームとほぼ一緒で、違いは「パスワード入力用TextBoxが無い」ことと「Cancelボタンが無い（OKボタンがCancelみたいなもの）」ことです。詳細は「予約取消のフォーム上レイアウト」を参照下さい。

９－２．フォームモジュール

９－２－１．初期設定

フォーム起動時に実行されるInitializeイベントプロシージャが図９－２です。

450. '==========　⇩(31)　初期設定　============
451. Private Sub UserForm_Initialize()
452. 　Me.CommandButton1.Cancel = True
453. 　Me.CommandButton1.SetFocus
454. End Sub

図９－２

この「確認」フォームは、フォーム起動後フォーム上で何も作業しないため、閉じるボタンをクリックしなくても「キーボードのESCキー及びEnterキーで閉じることが出来る」ようにします。

そのために、４５２行目「Me.CommandButton1.Cancel = True」で、CommandButton1のCancelプロパティをTrueにして「ESCキーでCommandButton1を押したことになる」ようにし、また４５３行目「Me.CommandButton1.SetFocus」で、フォームを起動したらCommandButton1にFocusを当てて置き、「Enterキーを押したら、CommandButton1を押したことになる」ように設定します。

但し今回の場合、操作できるコントロールがCommandButton1しか無いため、フォーム起動と同時にCommandButton1にFocusが当たりますので、４５３行目は無くても「Enterキーで閉じる」ことにはなります。

９－２－２．フォーム準備・起動

図６－８のKakuninプロシージャの１０１行目から呼び出されるのが、図９－３です。引数として「予約番号」を受取ります。

456. '==========　⇩(32)　フォーム準備・起動　============
457. Public Sub UFstart(Yno As Long)
458. 　Dim buf As Variant 　　　 '←予約番号Ynoに基づいた情報を入れる配列
459. 　Dim Status As String 　　 '←予約番号Ynoの現在の状態
461. 　Application.ScreenUpdating = False
462. 　　Call TableFilterOff(T_2)
463. 　　Call TableFilter(T_2, "Yno", CStr(Yno))
464. 　　buf = SearchList(T_2)
465. 　　Call TableFilterOff(T_2)
466. 　Application.ScreenUpdating = True
468. 　If IsEmpty(buf) = True Then
469. 　　MsgBox "予約番号(" & Yno & ")が存在しません。"
470. 　　Exit Sub
471. 　End If
473. 　If UBound(buf, 1) > 1 Then
474. 　　MsgBox "重複データ(" & buf(1, 1) & ")が存在します。"
475. 　　Exit Sub
476. 　End If
478. 　Me.Label1.Caption = buf(1, 1) 　　　 '←Yno
479. 　Me.Label2.Caption = buf(1, 2) 　　　 '←Bname
480. 　Me.Label3.Caption = buf(1, 3) 　　　 '←Kno
481. 　Me.Label4.Caption = buf(1, 7) 　　　 '←StartD
482. 　Me.Label5.Caption = buf(1, 8) 　　　 '←EndD
483. 　Me.Label6.Caption = buf(1, 4) 　　　 '←name
484. 　Me.Label7.Caption = buf(1, 5) 　　　 '←Dept
485. 　Status = buf(1, 9)
487. 　Select Case Status
488. 　　Case "Y"
489. 　　　Me.Label8.Caption = "予約期間"
490. 　　　Me.Caption = "予約中"
491. 　　Case "K"
492. 　　　Me.Label8.Caption = "貸出期間"
493. 　　　Me.Caption = "貸出中"
494. 　　Case "H"
495. 　　　Me.Label8.Caption = "貸出期間"
496. 　　　Me.Caption = "返却済"
497. 　End Select
499. 　Me.Show
500. End Sub

図９－３

４６２～４６５行目ではテーブルの絞り込み・解除をするので画面チラツキを抑えるため、４６１行目「Application.ScreenUpdating = False」で画面更新を停止させます。
４６２行目「Call TableFilterOff(T_2)」で、念の為「絞り込み解除」をします。
４６３行目「Call TableFilter(T_2, "Yno", CStr(Yno))」で、引数で得た「予約番号」で絞り込みをします。
４６４行目「buf = SearchList(T_2)」で、絞り込んだデータを取得し、配列bufに代入します。
４６５行目「Call TableFilterOff(T_2)」で、絞り込みを解除します。

４６８行目「If IsEmpty(buf) = True Then」では、配列bufが空（Empty）か否かを調べています。空と言うことは、４６３行目の「絞り込みの結果、何も得られなかった」という事ですから、テーブルのデータの中に「引数で渡された予約番号が存在しない」という事になります。
この原因としては、貸出表上のデータをユーザーが編集してしまった等が考えられますが、この状態では予約等の情報の表示も出来ませんので、４６９行目「MsgBox "予約番号(" & Yno & ")が存在しません。"」でコメントを出し、４７０行目「Exit Sub」で確認用フォームの表示を中止します。

逆に４７３行目「If UBound(buf, 1) > 1 Then」では、配列bufが複数行か否かを調べています。ユニークなはずの予約番号が複数存在する原因は、テーブルのデータを編集したり、人手でデータ追加した等が考えられます。しかし、どのデータが正しいのかがこの時点では不明なので、４７４行目「MsgBox "重複データ(" & buf(1, 1) & ")が存在します。"」でコメントを出し、４７５行目「Exit Sub」で確認用フォームの表示を中止します。

予約番号データが単一で取得できた時には、４７８～４８４行目で情報をフォーム内のLabelに代入します。
また、状態（Status）も４８５行目「Status = buf(1, 9)」で変数に代入し、以降で「状態に合ったフォーム」を作ります。

状態は今回システムでは３種です。それぞれの状態の時の「確認フォーム」を考えると、以下の様になります。

状態	ﾀﾞｲｱﾛｸﾞのﾀｲﾄﾙ	開始日～終了日
予約(Y)	予約中	予約期間
貸出(K)	貸出中	貸出期間
返却(H)	返却済	貸出期間

図９－４

これをSelect Caseで場合分けしたのが４８７～４９７行目です。
まず「予約（Y）」の場合は、４８９行目「Me.Label8.Caption = "予約期間"」で、開始日・終了日のタイトルを「予約期間」とします。また４９０行目「Me.Caption = "予約中"」で、ダイアログタイトルを「予約中」と状態を表示します。

次に「貸出(K)」の場合は、４９２行目「Me.Label8.Caption = "貸出期間"」で、開始日・終了日のタイトルを「貸出期間」とします。また４９３行目「Me.Caption = "貸出中"」で、ダイアログタイトルを「貸出中」と状態を表示します。
最後に「返却(H)」の場合は、４９５行目「Me.Label8.Caption = "貸出期間"」で「貸出状態」と同じで少し変かもしれませんが、開始日・終了日のタイトルを「貸出期間」としました。また４９６行目「Me.Caption = "返却済"」で、ダイアログタイトルを「返却済」と状態を表示します。

これでフォームの準備が整いましたので、４９９行目「Me.Show」でフォームを表示します。

「確認」ではデータ処理がありませんので、「OK」ボタンをクリックすると図９－５を呼出し、ダイアログ終了します。

502. '==========　⇩(33)　確認ダイアログの終了　============
503. Private Sub CommandButton1_Click()
504. 　Unload Me
505. End Sub

図９－５

１０．管理者用ユーザーフォーム(UserForm4)

１０－１．フォーム上レイアウト

備品の貸出・返却業務を行う時の管理者用フォームは、図１０－１のようにしました。

図１０－１

「予約取消」「確認」のフォームと同様に、予約番号を元とした登録情報をLabelで表示しています。他のフォームと異なるのは、下部に「管理者用パスワードの入力用テキストボックス」がある事です。
また実行用ボタン（CommandButton1）は、現在の状態の「次の状態」を表示文字にしています。

１０－２．フォームモジュール

１０－２－１．初期設定

管理用フォーム内で共通使用する定数・変数の宣言が図１０－２です。

507. '==========　⇩(34)　　============
508. Const PW As String = "" 　　　 '←管理者用パスワード
509. Dim Status As String 　　　　 '←現在の状態
510. Dim nextStatus As String 　　　 '←次の状態

図１０－２

５０８行目「Const PW As String = ""」は、管理者用パスワードの定数宣言です。今回サンプルファイルでは「""（長さゼロの文字列）」を設定しているため、パスワード無しで管理者実行が可能ですが、実運営の際には適切なパスワード（半角）の設定が必要です。
５０９行目「Dim Status As String」は「現在の状態」を示す変数、５１０行目「Dim nextStatus As String」は「次の状態」を示す変数です。

フォーム起動時に実行されるInitializeイベントプロシージャが図１０－３です。

512. '==========　⇩(35)　　============
513. Private Sub UserForm_Initialize()
515. 　Me.CommandButton2.Cancel = True
516. 　Me.TextBox1.IMEMode = fmIMEModeDisable
517. 　Me.TextBox1.PasswordChar = "*"
518. 　Me.TextBox1.SetFocus
519. End Sub

図１０－３

５１５行目「Me.CommandButton2.Cancel = True」は、Cancelボタン（CommandButton2）のCancelプロパティをTrueにし、「ESCキーを押すと、Cancelをしたことにする」ようにしています。
５１６行目「Me.TextBox1.IMEMode = fmIMEModeDisable」では、管理者パスワード欄（TextBox1）を入力する際は、日本語IMEをOFFにし、半角のみを入力するようにしています。
５１７行目「Me.TextBox1.PasswordChar = "*"」は、管理者パスワード欄（TextBox1）の表示文字を「*（アスタリスク）」にし、管理者パスワードが盗み見されないようにしています。
５１８行目「Me.TextBox1.SetFocus」では、フォーム起動後すぐにパスワードが入力できるように、管理者パスワード欄（TextBox1）にFocusを当てています。

１０－２－２．フォーム準備・起動

図６－９のKanriプロシージャの１１９行目から呼び出されるのが図１０－４です。引数として「予約番号」を受け取ります。

521. '==========　⇩(36)フォーム準備・起動　============
522. Public Sub UFstart(Yno As Long)
523. 　Dim buf As Variant 　　　 '←予約番号Ynoに基づいた情報を入れる配列
525. 　Application.ScreenUpdating = False
526. 　　Call TableFilterOff(T_2)
527. 　　Call TableFilter(T_2, "Yno", CStr(Yno))
528. 　　buf = SearchList(T_2)
529. 　　Call TableFilterOff(T_2)
530. 　Application.ScreenUpdating = True
532. 　If IsEmpty(buf) = True Then
533. 　　MsgBox "予約番号(" & Yno & ")が存在しません。"
534. 　　Exit Sub
535. 　End If
537. 　If UBound(buf, 1) > 1 Then
538. 　　MsgBox "重複データ(" & buf(1, 1) & ")が存在します。"
539. 　　Exit Sub
540. 　End If
542. 　Me.Label1.Caption = buf(1, 1) 　　　 '←Yno
543. 　Me.Label2.Caption = buf(1, 2) 　　　 '←Bname
544. 　Me.Label3.Caption = buf(1, 3) 　　　 '←Kno
545. 　Me.Label4.Caption = buf(1, 7) 　　　 '←StartD
546. 　Me.Label5.Caption = buf(1, 8) 　　　 '←EndD
547. 　Me.Label6.Caption = buf(1, 4) 　　　 '←name
548. 　Me.Label7.Caption = buf(1, 5) 　　　 '←Dept
549. 　Status = buf(1, 9)
551. 　Select Case Status
552. 　　Case "Y"
553. 　　　Me.Label8.Caption = "予約期間"
554. 　　　Me.Caption = "貸出（管理者用）"
555. 　　　Me.CommandButton1.Caption = "貸出"
556. 　　　nextStatus = "K"
557. 　　Case "K"
558. 　　　Me.Label8.Caption = "貸出期間"
559. 　　　Me.Caption = "返却（管理者用）"
560. 　　　Me.CommandButton1.Caption = "返却"
561. 　　　nextStatus = "H"
562. 　　Case "H"
563. 　　　Me.Label8.Caption = "貸出期間"
564. 　　　Me.Caption = "返却済み（管理者用）"
565. 　　　Me.CommandButton1.Caption = "操作不可"
566. 　　　Me.CommandButton1.Enabled = False
567. 　　　Me.TextBox1.Enabled = False
568. 　End Select
570. 　Me.Show
571. End Sub

図１０－４

５２６～５２９行目ではテーブルの絞り込み・解除をするので画面チラツキを抑えるため、５２５行目「Application.ScreenUpdating = False」で画面更新を停止させます。
５２６行目「Call TableFilterOff(T_2)」で、念の為「絞り込み解除」をします。
５２７行目「Call TableFilter(T_2, "Yno", CStr(Yno))」で、引数で得た「予約番号」で絞り込みをします。
５２８行目「buf = SearchList(T_2)」で、絞り込んだデータを取得し、配列bufに代入します。
５２９行目「Call TableFilterOff(T_2)」で、絞り込みを解除します。

５３２行目「If IsEmpty(buf) = True Then」では、配列bufが空（Empty）か否かを調べています。空と言うことは、５２７行目の「絞り込みの結果、何も得られなかった」という事ですから、テーブルのデータの中に「引数で渡された予約番号が存在しない」という事になります。
この原因としては、貸出表上のデータをユーザーが編集してしまった等が考えられますが、この状態では予約等の情報の表示も出来ませんので、５３３行目「MsgBox "予約番号(" & Yno & ")が存在しません。"」でコメントを出し、５３４行目「Exit Sub」で管理者処理を中止します。

逆に５３７行目「If UBound(buf, 1) > 1 Then」では、配列bufが複数行か否かを調べています。ユニークなはずの予約番号が複数存在する原因は、テーブルのデータを編集したり、人手でデータ追加した等が考えられます。しかし、どのデータが正しいのかがこの時点では不明なので、５３８行目「MsgBox "重複データ(" & buf(1, 1) & ")が存在します。"」でコメントを出し、５３９行目「Exit Sub」で管理者処理を中止します。

予約番号データが単一で取得できた時には、５４２～５４８行目で情報をフォーム内のLabelに代入します。
また、状態（Status）も５４９行目「Status = buf(1, 9)」で変数に代入し、以降で「状態に合ったフォーム」を作ります。

状態は今回システムでは３種です。それぞれの状態の時の「確認フォーム」を考えると、以下の様になります。

現在の状態	ﾀﾞｲｱﾛｸﾞのﾀｲﾄﾙ	開始日～終了日	次の状態	実行内容
予約(Y)	貸出(管理者用)	予約期間	K	貸出
貸出(K)	返却(管理者用)	貸出期間	H	返却
返却(H)	返却済(管理者用)	貸出期間	無し	操作せず

図１０－５

これをSelect Caseで場合分けしたのが５５１～５６８行目です。
まず現状が「予約（Y）」の場合は、５５３行目「Me.Label8.Caption = "予約期間"」で、開始日・終了日のタイトルを「予約期間」とします。また５５４行目「Me.Caption = "貸出（管理者用）"」で、ダイアログタイトルを「貸出」に、また５５５行目「Me.CommandButton1.Caption = "貸出"」で、実行ボタン（CommandButton1）の表示文字列を「貸出」にすることで、「今から処理するべき状態」を表示するようにしました。
また５５６行目「nextStatus = "K"」で、「次の状態を示すnextStatus変数」を「K（貸出）」にセットします。このnextStatus変数は、貸出／返却処理を実行する際の「テーブルの新しいStatus値」になります。

次に現状が「貸出(K)」の場合は、５５８行目「Me.Label8.Caption = "貸出期間"」で、開始日・終了日のタイトルを「貸出期間」とします。また５５９行目「Me.Caption = "返却（管理者用）"」で、ダイアログタイトルを「返却」に、また５６０行目「Me.CommandButton1.Caption = "返却"」で実行ボタン（CommandButton1）の表示文字列を「返却」にすることで、「今から処理するべき状態」を表示するようにしました。
また５６１行目「nextStatus = "H"」で、「次の状態を示すnextStatus変数」を「H（返却）」にセットします。

最後に現状が「返却(H)」の場合は、５６３行目「Me.Label8.Caption = "貸出期間"」で「現状が貸出」の時と同じですが、開始日・終了日のタイトルを「貸出期間」とします。また５６４行目「Me.Caption = "返却済み（管理者用）"」で、ダイアログのタイトルを「返却済」に、また５６５行目「Me.CommandButton1.Caption = "操作不可"」で実行ボタン（CommandButton1）の表示文字列を「操作不可」にすることで、「次の状態は無い」ことを表します。
更に５６６行目「Me.CommandButton1.Enabled = False」でボタン操作不可にし、５６７行目「Me.TextBox1.Enabled = False」でパスワード入力欄も不使用にさせています。
なお、実行ボタン（CommandButton1）の操作を出来なくしていますので、変数nextStatusは使わず設定もしません。

これでフォームの準備が整いましたので、５７０行目「Me.Show」でフォームを表示します。

１０－２－３．貸出／返却処理の実行

実行ボタンである「貸出」または「返却」ボタンをクリックした時に呼び出されるのが、図１０－６です。

573. '==========　⇩(37)　貸出／返却処理の実行　============
574. Private Sub CommandButton1_Click()
576. 　If Not Me.TextBox1.Text = PW Then
577. 　　MsgBox "管理者パスワードが違います"
578. 　　Exit Sub
579. 　End If
581. 　Application.ScreenUpdating = False
582. 　　Call TableFilterOff(T_2)
583. 　　Call TableFilter(T_2, "Yno", CStr(Me.Label1.Caption))
585. 　　Call TableDataUp(T_2, "Status", nextStatus)
587. 　　Select Case nextStatus
588. 　　　Case "K"
589. 　　　　If CDate(Me.Label4.Caption) < Date And CDate(Me.Label5.Caption) >= Date Then
590. 　　　　　Call TableDataUp(T_2, "startD", Date)
591. 　　　　End If
592. 　　　Case "H"
593. 　　　　If CDate(Me.Label4.Caption) <= Date And CDate(Me.Label5.Caption) > Date Then
594. 　　　　　Call TableDataUp(T_2, "endD", Date)
595. 　　　　End If
596. 　　End Select
598. 　　Call TableFilterOff(T_2)
599. 　Application.ScreenUpdating = True
601. 　Call T1make
602. 　Unload Me
603. End Sub

図１０－６

まず５７６～５７９行目では、入力した管理者パスワードが正しいか否かをチェックしています。
５７６行目「If Not Me.TextBox1.Text = PW Then」で、図１０－２の５０８行目で宣言してある定数PWとパスワード欄の文字列を比較します。異なる場合は５７７行目「MsgBox "管理者パスワードが違います"」でコメントを出し、５７８行目「Exit Sub」で処理を中止します。

５８２～５９８行目では、テーブルの絞り込み・解除を行うため、画面チラツキを防止するため５８１行目「Application.ScreenUpdating = False」で画面更新を停止させます。
５８２行目「Call TableFilterOff(T_2)」で、念の為に絞り込み解除をしています。
５８３行目「Call TableFilter(T_2, "Yno", CStr(Me.Label1.Caption))」では、「予約番号Yno」をダイアログのLabelから取得し、テーブルを予約番号（Yno）で絞りこんでいます。別な方法としては「（予約取消の工程のように）モジュール共通変数を使ってフォーム呼び出し元からの予約番号を代入してから使用」するようにしてもOKです。

今の段階でテーブル上で可視化されているのは、対象としている予約番号の行のみです。そこで５８５行目「Call TableDataUp(T_2, "Status", nextStatus)」でTableDataUpプロシージャ（図６－２０）を呼出し、「テーブルの可視セルの内のStatus列（状態）の値を『nextStatus変数値（次の状態）』に書き換え」ます。「nextStatus変数値」は、図１０－４の５５６行目または５６１行目で値が代入されています。

５８７～５９６行目では、貸出日・返却日のデータ修正を行っています。
まず「予約→貸出」に移行する際の考え方は、図１０－７のように「予約時の期間内で、貸出開始予定日より遅れて貸し出した時は、貸出日を開始日」にします。その際終了日は、次に借りる人の予定が入っている可能性があるため、変更無し（貸出期間は減る）です。

図１０－７

一方「貸出→返却」に移行する際の考え方は、図１０－８のように「貸出時の期間内で、返却予定日より早く返却した時は、返却日を終了日」にします。これにより、次の貸出開始予定日との間に空き日が発生することで、次に借りる人の予定を早めることが出来たり、隙間で別の人が借りる事も可能になります。

図１０－８

コード的には、５８７行目「Select Case nextStatus」で「次の状態」を調べ、「貸出（K）」であれば５８９～５９１行目を実行します。
５８９行目「If CDate(Me.Label4.Caption) < Date And CDate(Me.Label5.Caption) >= Date Then」では、２つの式をAndで結んでいます。前半の「CDate(Me.Label4.Caption) < Date」は「貸出予定日 ＜ 今日の日付（貸出日）」ですので、図１０－７のような「予定より遅い貸出日」となります。
一方後半の「CDate(Me.Label5.Caption) >= Date」は「貸出終了日＞＝今日の日付（貸出日）」ですので、「予約期間の終了日より前に貸し出す」となります。プログラム的に言えば、２番目の式を入れないと「開始日と終了日が逆転する」ことになりますし、実社会で言えば「予約期間が過ぎてから貸し出すのはは、何のための予約か分からなくなる」と言うことになります。
このIf文が成立する時は、５９０行目「Call TableDataUp(T_2, "startD", Date)」で、TableDataUpを呼出し、開始日を今日の日付（貸出日）に変更します。

次の状態が「返却（H）」であれば５９３～５９５行目を実行します。
５９３行目「If CDate(Me.Label4.Caption) <= Date And CDate(Me.Label5.Caption) > Date Then」も２つの式で出来ています。前半の「CDate(Me.Label4.Caption) <= Date」は「貸出開始日 ＜＝ 今日の日付（返却日）」であり、「開始日と終了日の逆転」を防いでいます。
後半の「CDate(Me.Label5.Caption) > Date」は「貸出終了日＞今日の日付（返却日）」で、図１０－８の「予定より早く返却した」状態を示します。
このIf文が成立する時は、５９４行目「Call TableDataUp(T_2, "endD", Date)」で、終了日を今日の日付（返却日）に変更します。

データの更新が完了したら、５９８行目「Call TableFilterOff(T_2)」で絞り込みを解除し、６０１行目「Call T1make」で貸出表を更新したのち、６０２行目「Unload Me」でダイアログを閉じます。

ダイアログのキャンセルボタン（CommandButton2）をクリックした時に呼び出されるのが図１０－９です。
何もせずに、６０７行目「Unload Me」でダイアログを閉じます。

605. '==========　⇩(38)　キャンセルボタン　============
606. Private Sub CommandButton2_Click()
607. 　Unload Me
608. End Sub

図１０－９

１１．データテーブル・マクロの非表示化

サンプルファイルでは非表示化していませんが、ユーザーが勝手にテーブル内容を編集出来てしまったり、また他人の「取消パスワード」を見る事が出来てしまっては困ります。またマクロ内容が見られてしまうと「管理者パスワード」も漏れてしまいます。
そのためシステム実行時は「テーブルのシート（Sheet2）の非表示化」および「マクロの非表示化」を行う必要があります。
ただしパスワードを忘れてしまうと、誰にも開けなくなりますので、管理には充分注意して下さい。

１１－１．シートの非表示

シートを非表示にするには図１１－１のように、まず非表示にしたいシート（今回システムではSheet2）をアクティブにし、シートのタブでマウス右クリックします。すると、シートに対するメニューが現れますので、その中から非表示①を選択します。
すぐにSheet2は非表示となり、（今回システムでは）Sheet1のみになります。

図１１－１

これだけですと、非表示にしたシートは誰でも再表示できてしまいます。ですので、次にブックの保護を行います。
図１１－２のように、リボンの「校閲」タブ→「保護」グループ→「ブックの保護」ボタンをクリックします。

図１１－２

すると「シート構成とウィンドウの保護」ダイアログ②が表示されます。保護対象として「シート構成」にレ点を付けた上で、パスワードを入力します。
OKボタンをクリックすると、もう一度パスワードを聞いてきますので、同じパスワードを再入力③します。

この操作により図１１－３のように、シートを再表示しようとしても、操作が出来ない状態④になっています。

図１１－３

再表示させるには、再びリボンの「校閲」タブ→「保護」グループ→「ブックの保護」ボタンをクリックします。すると図１１－４のようにパスワードを求められますので、入力しOKボタンをクリックすると、シートの再表示が可能になります。

図１１－４

１１－２．マクロの非表示

マクロの非表示には、図１１－５のようにVBEのメニューの「ツール」→「VBA Projectのプロパティ①」をクリックします。

図１１－５

すると「プロジェクト プロパティ」のダイアログが表示されますので、「プロジェクトのロック」にレ点を付け、パスワード（２箇所に同じパスワード）を入力②します。OKボタンで閉じた後、ファイル保存して一旦閉じます③。

図１１－６

すると、コードを見る為にVBEのプロジェクトウィンドウを操作しようとすると、図１１－７のようにパスワードを求められる④ようになります。もちろんパスワードを入力すれば、コードの閲覧・編集が可能となります。

図１１－７

１２．最後に

テーブル（ListObject）を使ったのは今回で２回目ですが、少し慣れてくると「Cells(Rows.Count,1).End(xlUp)」などとデータ範囲を調べていたのが「なんて手間な事をやっていたんだ」と思うようになります。もちろんデータベースっぽくデータが並んでいる時に限りますが、Excelの一番のメインの使い方のはずなので、使わない手は無いと思います。

一方でデータベースっぽく扱えるのに、Excelのテーブルでは、列の「ユニーク制約」や「Not Null制約」は設定できそうにありません。ですので、データが重複したり、空だったりした時のチェックがExcelでは必要になってしまいます。

またそのチェックの為に、今回は色々な場所にエラートラップを設けましたので、エラーが発生（例：予約番号の重複）した時には、複数回コメントが出てしまいます。プロシージャを単機能にし、その中でエラーコメントも表示させて完結するようにすると、このような現象が発生するのは容易に想像がつきます。
想定内のエラーは除き、異常の際はシステム共通のエラー処理プロシージャにジャンプし一括処理をする　などの工夫が必要なのかもしれません。


先行予約可能な備品予約・貸出システム（it-064.xlsm）

セキュリティ向上を目的として「インターネット経由でダウンロードしたOfficeファイル（Excel等）のマクロは、既定でブロック」されるようにOfficeアプリケーションの既定動作が変更になりました。（2022年4月より切替開始） 解除の方法については「ダウンロードファイルのブロック解除方法」を参照下さい。