2022/04/09

OLEObjectのラベルカレンダー(同一ブック内)

• １．背景
• ２．システム概要
• ３．プログラムの流れ
• 　３－１．カレンダーの作成・削除の流れ
• 　３－２．カレンダーサイズの変更・保持の流れ
• ４．入力用シート
• 　４－１．ワークシート
• 　４－２．シートモジュール
• ５．標準モジュール
• 　５－１．起動プロシージャ
• 　５－２．変数再設定
• 　　よりみち（OnTimeでPrivateを呼び出す）
• 　５－３．文字サイズ変更
• 　　よりみち（PC解像度で異なる文字の横幅）
• 　５－４．カレンダー表示位置・サイズの計算
• 　５－５．カレンダー作成
• 　５－６．カレンダー上の操作
• 　　よりみち（Label内での改行マーク）
• 　５－７．カレンダーサイズの変更
• ６．クラスモジュール
• ７．アドインとしてExcelにマクロを登録
• ８．最後に
• サンプルファイル

１．背景

今まで「カレンダーを使って、セルに日付値を入力」するものとして、以下を紹介してきました。
「セルへの日付入力をカレンダー日付クリックで選定する」
「MonthViewコントロールを使ったカレンダー」
「図形カレンダーをクリックし日付入力」
「ラベルカレンダーをクリックし日付入力」
「ボタンを自動生成するフォームカレンダー」
これらは全て「フォーム（UserForm）上にカレンダーを作成」するものです。フォームは便利で作るのも楽ですし、ユーザーの好きな位置に移動も出来ます。しかし「たかが日付を１つ入力するのに、フォームを作らなければならないのは如何なものか」という気持ちもあり、「フォームより手軽なカレンダー」で入力することは出来ないものかと前々から考えていました。

そこで今回は、OLEObject（ワークシート上に貼り付けるActiveXコントロール）のラベルを使い、「手軽（に見える）」なカレンダーを紹介します。

なおマクロを使って「OLEObjectをマクロのあるブックに作成」すると、一連の動作が終了（今回だと、カレンダーが完成）した時点でVBAコードが終了（Endステートメントが実行される感じ）してしまうため、作ったOLEObjectを指す「オブジェクト変数」も解除されますし、クラスで設定したWithEventsとの繋がりも消えてしまい、せっかく設定したイベントも発生しなくなってしまいます。
別の項「OLEObjectのラベルカレンダー(アドイン専用)」では、操作マクロのあるBookとOLEObjectのカレンダーを作成するBookは別というものを紹介しました。別なBookにOLEObjectを作るのであれば上記のような現象は発生しませんが、今回の項では「操作マクロとOLEObjectは同じBook」であるシステムを紹介します。上記のように変数がクリアされてしまうために、OnTimeメソッドを使った変数再設定の工夫を盛り込んでいます。

２．システム概要

今回システムは、カレンダーを作成するマクロ部分と日付入力部分が「同じBook」であっても「別なBook」であっても動作します。何かのシステムにカレンダー機能を盛り込むのであれば同じBookとなる事もあると思いますし、汎用的に各自PCにアドイン登録をしておけば、シートモジュールのコードのみでカレンダーを使用することも出来ます。
アドイン登録の場合は「アドインとしてExcelにマクロを登録」に従ってExcelにアドイン登録し、有効状態にしておきます。

日付入力が必要なシート上に、図２－１のように２ヶ所の日付入力セル（黄色いセル）があるとします。そのシートに対し、図４－２のようなSelectionChangeイベントを仕掛けておき、そのセルを選択したらラベルカレンダーが表示され、選択した日付をそのセルに書き込む、というのが今回のシステムです。

図２－１

日付入力セルが「空白セル」や「日付では無い文字列」が入っている場合、そのセルを選択①すると「今月のカレンダー②」が表示されます（図２－１の左側）。
一方、日付が入っているセルを選択③した場合は、「その日を含む月のカレンダー④」が表示されます（図２－１の右側）。

カレンダーは図２－２のように、選択した日付入力セルの右横に表示されます。

図２－２

カレンダーの上部中央には「表示カレンダーの年月」が表示されており、その両脇の「<<」「<」「>」「>>」印の部分をクリックすることで、カレンダーの表示を「１年戻る・進む」「１ヶ月戻る・進む」させることが出来ます。
希望の年月にカレンダーを移動させた後、日付の部分をクリックすることで、「カレンダーが消え」ると同時に「選択したセルに日付が入力」されます。
なお、日付を入力せずに終了するには、選択しているセル以外のセルを選択（＝選択セルを変更）します。選択セルを変更した先も「日付入力セル」に登録してあった場合は、古いカレンダーは一旦消え、新たなセルでのカレンダーが表示されます。

また、カレンダー上部の「◎印」をクリックすると、表示年月はそのままで図２－３のように「カレンダーのサイズ」を変えられます。今回サンプルファイルでは６段階で、サイズ小→サイズ大の順に変化し、最大の次は最小サイズになります。設定したサイズは、Excelを閉じるまで記憶しています。なお、起動時は12ポイントのサイズで表示されます。

図２－３

３．プログラムの流れ

「背景」にも記しましたが、ブックにOLEObjectを追加すると、追加されたブックにとっては「新たな操作対象オブジェクトが追加」された形になります。そのブック内のVBAにしてみれば「再コンパイル相当の処理が必要な状態」になるため、マクロでOLEObjectを作成するという一連の動作が終了した時点でVBAコードが終了（Endステートメントが実行される形）することになるようです。
なお、別なブック上にOLEObjectが追加されても「マクロのあるブックには無関係」なので、変数等が保持・継続していきます。
今回システムは、マクロのあるBookと日付を入力する作業Bookが同一という環境でも動作するようにしています。

３－１．カレンダーの作成・削除の流れ

カレンダー本体の流れは図３－１のようになります。

図３－１

シート上にはSelectionChangeイベントが仕掛けてあり、どのセルを選択してもプログラムを呼び出します。呼び出す時は、選択セル位置と併せて、選択したセルが「日付入力セルか否か」の情報も一緒に渡します。

カレンダー用のLabelを作る前に、まずは既存のカレンダーLabelがあれば削除します。次に、選択したセルが「日付入力セル以外」の場合は、そこでマクロ終了します。終了する場面としては「カレンダーを消すために日付入力セル以外を選択」したか、又は「日付入力以外の作業」ですので、カレンダーが消去されるか、何も起きない　という状況になります。

選択したセルが「日付入力セル」の場合には、OLEObjectのLabelを作成します。作成完了すると、残念ながらVBAが終了し、変数などがクリアされてしまいます。
そこで今回は、Labelの作成の直後にOnTimeメソッドで「変数保持用プロシージャ（setVar）」を呼び出しておきます。OnTimeメソッドですのですぐには呼び出せず、一連の動作が終了した後（＝変数がクリアされた後）で「変数保持用プロシージャ」が実行されます。

変数保持用プロシージャ内では、「直前に作られたOLEObject ＝ カレンダーLabel 」「現在アクティブのセル ＝ 選択セル」と判断をして、モジュール共通変数に代入します。また、直前に作られたOLEObject（Label）の文字サイズを調べて、同じく共通変数Szにその値を代入します。
その後、選択セル値から表示年月を計算し、その表示年月でのカレンダーの文字列を組み立て、カレンダーLabelのCaptionに設定しカレンダーが完成します。

カレンダーLabelをクリックした時に「Clickイベント」が発生するように、クラスにWithEvents宣言をし、変数保持用プロシージャ内でイベントが有効になる設定をしておきます。ユーザーがカレンダーLabel上をクリックすると、クリックした位置（XYの座標値）が分かりますので、そこから「クリックした位置に書いてある文字列」や「何行目なのか」を計算します。

クリックしたのが１行目であれば「カレンダーの年月移動」ですので、取得した文字列から「1年前」「1ヶ月前」「1ヶ月後」「1年後」の「表示カレンダーの年月」を計算し、再度カレンダー文字列を組み立て直し、LabelのCaptionを入れ替えます。
一方クリックしたのが3行目以降であり、且つ数値であった場合は、「ユーザーはカレンダーの日付をクリックした」ことになりますので、表示カレンダーの年月と合わせて「日付値」を作成し、日付入力セルにその値を書き込みます。

３－２．カレンダーサイズの変更・保持の流れ

今回のカレンダーはサイズを変えることができ、カレンダー左上◎印をクリックすることで小→大になります。そのサイズは「Labelの文字サイズ」で決まり、その文字サイズを今回マクロ内では「変数Sz値」として管理しています。


図３－２

起動直後は変数Sz値は空ですので、空の場合は既定値を変数Szに代入します。OLEObjectのLabelは「表示する位置・サイズ」を決めてから作成しています。（作った後で位置・サイズを変更すると、ユーザーにLabelのサイズが変化しているのが見えてしまう為。）
Labelの文字サイズ（Font.Sizeプロパティ）の設定はLabelの作成と同時にはできませんので、作った後から設定します。それと同時に、OnTimeメソッドで「変数保持用プロシージャ（setVar）」を呼び出しておきます。

文字サイズだけが設定された空のLabelが完成した後に「変数保持用プロシージャ」が実行されます。この時には既に文字サイズの変数Sz値はクリアされています。
変数保持用プロシージャ内では、最後に作られたOLEObjectの文字サイズを調べ、変数Szに再設定します。その後で図３－２には書いていませんが、カレンダーの内容を作成し、LabelのCaptionプロパティに設定します。

カレンダーをクリックした時には、LabelのClickイベントが発生し、クリックした位置の文字列を計算します。クリックした文字列が「◎」印だった場合は、事前に配列として設定してある候補のサイズの中から「現状の文字サイズの次の文字サイズ」を選択しSz値に代入します。
◎印を操作する時には、カレンダーの年月を移動する必要は無い（＝Labelの文字列は変更無し）ので、Labelの縦横サイズのみを変更します。これにより、カレンダーサイズが変わります。

４．入力用シート（サンプルファイルではSheet1）

４－１．ワークシート

ワークシート上の数式や加工などは、本システムでは不要です。必要なのは、SelectionChangeイベント等の設定です。
なおサンプルファイルでは、入力セルがどこなのか分かるように、図４－１のように黄色背景にしています。

図４－１

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

入力シートには図４－２のような「Worksheet_SelectionChange」イベントプロシージャを置きます。引数のTargetは選択したセル範囲です。
このプロシージャは、あらかじめ設定した日付入力セルを選択した時に、カレンダーを呼び出すものです。また、それ以外のセルを選択した時にはカレンダーを消す役目も持っています。

1. '==========　⇩(1)　入力シートのSelectionChangeイベント　============
2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
3. 　Dim isD As Boolean 　　 '←日付入力セル=True、それ以外=False
5. 　If Target(1).Address = Range("B2").Address _
6. 　　　　Or Target(1).Address = Range("D2").Address Then
7. 　　isD = True
8. 　End If
10. '　Workbooks("it-080.xlam").Application.Run "LabelCalStart", Target(1), isD 　 '←アドインの時
11. 　Call LabelCalStart(Target(1), isD)　　'←カレンダーマクロが同じBook内に存在する時
13. End Sub

図４－２

３行目「Dim isD As Boolean」は、マクロ側に渡す第二引数「isD（is Date の略のつもり）」を宣言しています。選択したセル範囲が「日付入力セル（True）」か「それ以外（False）」かを表すフラグ変数です。

５～６行目「If Target(1).Address = Range("B2").Address Or Target(1).Address = Range("D2").Address Then」では、日付入力セル（ここでは、B2セル・D2セル）の場合には、７行目「isD = True」でフラグ変数isDをTrueに設定します。

見え消しにしている１０行目は、この「サンプルファイル」をアドインした時に、呼び出すコードです（サンプルファイルでは、１０行目は無効になっています）。
１０行目「Workbooks("it-080.xlam").Application.Run "LabelCalStart", Target(1), isD」で、Excelアドインされた起動マクロ「LabelCalStart（図５－２）」を呼び出しています。但し、対象が同じブック内では無いので「Callステートメント」では呼び出せませんので、「Application.Runメソッド」を使って「アドイン内のExcelファイルのプロシージャ」を呼び出しています。
LabelCalStartプロシージャ（図５－２）には、２つの引数を渡す事になっています。第一引数は「選択されたセル範囲」なので２行目で得られるTargetを使います。なおTargetが複数セル範囲を指す場合もありますが、今回システムでは「日付は１つのセルに入力」するものとしていますので「Target(1)」としています。
なお、５～６行目でもTarget(1)と左上セルを判断対象としていますので、それと合わせる意味もあります。

第二引数は、７行目で値を代入した「日付入力セルか否か」のフラグ変数isDを渡します。なお、今回で言えばB2セル・D2セル以外のセルを選択した場合は、３行目「Dim isD As Boolean」で変数isDは初期化されていますのでFalse値を第二引数として渡すことになります。

１１行目「Call LabelCalStart(Target(1), isD)」は、同じExcelブック内に呼出しマクロがある場合のコードです（サンプルファイルも、１１行目が有効になっています）。
同じBook内なので、Callステートメントで起動マクロ「LabelCalStart（図５－２）」を呼び出しています。２つの引数は上記説明と同じく、「選択されたセル範囲」と、そのセルが「日付入力セルか否か」のフラグ変数を渡します。

なお、フォームを使用したカレンダーを呼び出す時には「Function関数を呼び出し、その戻り値をTargetに書き込む」という手法を良く使いますが、今回はモーダルで呼び出した時の様な「フォームの操作しか出来ない」状況を作り出すことが出来ませんので、この手法は使えません。
そのため、選択したセル位置（第一引数の値）をマクロ内に記憶しておき、カレンダーの日付をクリックした時に「記憶しておいたセル位置に日付を書き込む」仕様としています。

５．標準モジュール（Module1）

標準モジュール先頭部分（宣言部：図５－１）では、システム内で共通して使用する変数の宣言をしています。

15. '==========　⇩(2)　システム内で使用する共有変数の宣言　============
16. Private CL As New Class1 　　　　　 '←Labelのクラスを宣言・生成
18. Private addLBL As OLEObject 　　　 '←Labelカレンダーオブジェクト
19. Private selectR As Range 　　　　　 '←選択セル
20. Private Calyymm As Date 　　　　　 '←カレンダーの表示年月
21. Private Sz As Single 　　　　　　　 '←カレンダーのサイズ
23. Private Const title1 As String = " ◎ " 　　　 '←拡大縮小
24. Private Const title2 As String = " << " 　　　 '←1年戻る
25. Private Const title3 As String = " < " 　　　 '←1ヶ月戻る
26. Private Const title4 As String = " > " 　　　 '←1ヶ月進む
27. Private Const title5 As String = " >> " 　　　 '←1年進む
28. Private Const title6 As String = " × " 　　　 '←閉じる

図５－１

１６行目「Private CL As New Class1」は、カレンダーLabelを生成しています。型は「Class1」と、クラスモジュールで宣言しているMSForms.Label型になります。

１８行目「Private addLBL As OLEObject」は、シート上に作られるカレンダーLabelオブジェクト変数です。
１９行目「Private selectR As Range」は、ユーザーが選択したセル位置です。
２０行目「Private Calyymm As Date」は、表示するカレンダーの初日の日付です。
２１行目「Private Sz As Single」は、カレンダーLabelのフォントサイズです。

２３～２８行目は、カレンダー上部（１行目）に配置する、カレンダー操作用ボタンの文字列です。今回カレンダーにはLabel以外のコントロールは使用しませんので、Label内の文字列が表示月を送る等の操作ボタンの役目を担います。
今回は、「◎ ＝ カレンダーのサイズを拡大縮小」「<< ＝ 1年戻る」「< ＝ 1ヶ月戻る」「> ＝ 1ヶ月進む」「>> ＝ 1年進」「× ＝ カレンダーを閉じる」という文字列を割り当てました。
なお、カレンダー上のどこをクリックしたかの計算を楽にするため、今回は「半角4文字」で１セットとしましたので、各文字列両脇には「スペース」を入れて文字数を合わせています。例えば「" << "」では両端に1個ずつスペースを、「" < "」では前側に1個、後側に2個のスペースを入れています。

５－１．起動プロシージャ

図４－２の１０行目または１１行目から呼び出されるのが、起動プロシージャである図５－２です。引数を２つ受け取り、第一引数は「選択されたセル位置」、第二引数は「その選択セルが、日付入力セル（＝カレンダーを表示させるセル）か否か」です。

30. '==========　⇩(3)　システム起動　============
31. Public Sub LabelCalStart(Target As Range, isD As Boolean)
32. 　Dim T As Single 　　 '←LabelカレンダーのTop位置
33. 　Dim L As Single 　　 '←LabelカレンダーのLeftp位置
34. 　Dim H As Single 　　 '←Labelカレンダーの高さ
35. 　Dim W As Single 　　 '←Labelカレンダーの幅
37. 　Set selectR = Target(1)
39. 　On Error Resume Next
40. 　　addLBL.Delete
41. 　　Set addLBL = Nothing
42. 　On Error GoTo 0
44. 　If isD = False Then
45. 　　Application.OnTime Now(), "'keepSz " & Sz & "'"
46. 　　Exit Sub
47. 　End If
49. 　Call setSz(False)
50. 　Call getPos(Target, T, L, H, W)
52. 　Set addLBL = selectR.Parent.OLEObjects.Add("Forms.Label.1", _
53. 　　　　　　　　　Top:=T, Left:=L, Height:=H, Width:=W)
55. 　With addLBL.Object
56. 　　.Font.Size = Sz
57. 　　.Font.Name = "ＭＳ ゴシック"
58. 　　.BorderStyle = fmBorderStyleSingle
59. 　End With
61. 　Application.OnTime Now(), "setVar"
63. End Sub

図５－２

３２～３５行目は、カレンダーの位置とサイズの変数宣言です。５０行目で呼び出す「getPosプロシージャ」内で計算された位置・サイズのデータをT・L・H・W として受け取り、５２～５３行目でLabelを作る時の位置・サイズに使用します。

３７行目「Set selectR = Target(1)」は、引数として受け取った選択セル範囲の１番目（左上角）のセルを変数selectRに代入しています。最終的にカレンダーの日付をクリックした時には、その日付をselectRのセルに貼り付けます。

４０行目「addLBL.Delete」では、既存の古いカレンダーを削除しています。これは新たなカレンダーを作るための準備で、古いカレンダーを一旦消しておかないと、新旧複数のカレンダーが出来てしまいます。
しかし起動直後や、日付入力セル以外を連続して選択した場合は「削除するカレンダーが無い」ために、エラーが発生してしまいます。ですので３９行目「On Error Resume Next」でエラー時にスルーさせるようにしています。
４１行目「Set addLBL = Nothing」は、カレンダーのLabelオブジェクトを解除しています。

４４行目「If isD = False Then」では、変数isD（選択セルが日付入力セルか否か）がFalse（日付入力セル以外）の場合には、まず４５行目「Application.OnTime Now(), "'keepSz " & Sz & "'"」で、図５－６「keepSzプロシージャ」をOnTimeで呼び出しておきます。

OnTimeメソッドの第一引数には「実行する時刻」を指定しますが、今回は「Now()」としています。これは「今すぐ」という意味ですが、かといってプログラムが流れている間は実行されません。一連の処理が終了（４６行目「Exit Sub」でプロシージャを抜け、シートモジュールのSelectionChangeイベントプロシージャを抜けた時）した後に実行されます。なおその時には、旧カレンダーLabelが削除されVBAの環境が変わってしまっている為に全ての変数がクリアされてしまっています。

第二引数はプロシージャ名とその引数です。プロシージャ名「keepSz」の後ろに1つのスペースを入れ、その後に「現在の文字サイズ値Sz」を続けます。なお、第二引数（プロシージャ名＋引数値）の全体を「'（シングルクォーテーション）」で括ります。
呼び出すkeepSzプロシージャ（図５－６）では、クリアされてしまった変数Szを「引数で受け取ったSz値」で再設定します。

最後に４６行目「Exit Sub」で処理を中止します。この時には古いカレンダーは削除済みです。つまり「日付入力セル以外を選択」すると「カレンダーは消えて完了」することになります。

４９行目「Call setSz(False)」では、図５－７を呼び出します。引数にFalseを指定していますので「Labelの文字サイズSz値は変更しない」で、もし「Sz値が無い（＝初期値のゼロ）場合は、既定のサイズ値を変数Szに代入」をします。
５０行目「Call getPos(selectR, T, L, H, W)」では、図５－１０を呼び出します。引数は５つありますが、こちらから渡すのは第一引数の「selectR（＝選択したセル）」のみです。getPosプロシージャ内では、第一引数のselectRと、Labelの文字サイズ変数Sz値を使って「新たに作成するLabelの　T（上下方向の位置）, L（左右方向の位置）, H（高さ）, W（幅）」を計算し、引数（第二～第五の T, L, H, W）として戻してくれます。

５２～５３行目「Set addLBL = selectR.Parent.OLEObjects.Add("Forms.Label.1", Top:=T, Left:=L, Height:=H, Width:=W)」では、Labelを作成しています。
まずLabelを作るシートは「selectR.Parent」としています。今回システムではワークシート側から「シート名などのシート情報を直接の形では受け取っていない」ために、選択セル位置に含まれているシート情報を使っています。
作るOLEObjectは「Forms.Label」で、作る位置サイズは、上下方向（Top:=）左右方向（Left:=）高さ（Height:=）幅（Width:=）で設定し、その値には５０行目で得た「変数T, L, H, W」を使用します。

なお、Top:= ･･･以下の位置・サイズ指定をOLEObjects.Addの引数にしないで、Labelを作成した後で設定することも可能です。しかし、位置・サイズを未指定で作成すると、図５－３のように「選択したアクティブセル上にまず既定サイズのLabelが作られる②」ために、一瞬選択セル（今回の場合、黄色背景のセル）がLabelの白で覆われた感じに見えます。

図５－３

そこで５２～５３行目では、位置・サイズを指定した状態でLabelを作成しています。結果としては図５－４のように、位置・サイズは狙った通りに作成されるのですが、残念ながらLabelの初期値Caption「Label1」は一瞬見えてしまいます。
カレンダーの内容をCaptionに設定するまで「Application.ScreenUpdating = False」で画面更新停止させてみたのですが効果なく、この辺りが限界の様です。

図５－４

５５～５９行目は、５２～５３行目で作成したLabelのプロパティを設定しています。設定する対象は５５行目「With addLBL.Object」で指定しています。５２～５３行目で作ったOLEObjectオブジェクトは左辺の変数addLBLに代入されていますが、実体のObjectであるLabelは、その１つ下の「addLBL.Object」として表されるためです。

５６行目「.Font.Size = Sz」では、そのLabelのフォントサイズを、４９行目で計算した共通変数Sz値に設定します。
５７行目「.Font.Name = "ＭＳ ゴシック"」では、文字フォントを「ＭＳ ゴシック」に設定します。この書体は「どんな半角文字でも横幅は同じ」であるため、方眼紙の中に文字を埋めていくように「計算通りの表示」をすることが出来ます。「横幅が同じ」であるならば、この書体以外でもOKです。
５８行目「.BorderStyle = fmBorderStyleSingle」は、カレンダーの外枠を「有り」の設定にしています。

６１行目「Application.OnTime Now(), "setVar"」では、図５－５「setVarプロシージャ」をOnTimeで呼び出しておきます。

OnTimeメソッドの第一引数には「実行する時刻」を指定しますが、今回は「Now()」としています。これは「今すぐ」という意味ですが、かといってプログラムが流れている間は実行されません。一連の処理が終了（このプロシージャを抜け、シートモジュールのSelectionChangeイベントプロシージャを抜けた時）した後に実行されます。なおその時には、新たなカレンダーLabelが作成されVBAの環境が変わってしまっている為に全ての変数がクリアされてしまっています。

第二引数はプロシージャ名です。呼び出すsetVarプロシージャ（図５－５）では、新たに作ったカレンダーLabelのオブジェクト変数の設定やそのイベント有効化、選択しているセル範囲の登録、およびクリアされてしまった変数Szの再設定等をします。そこまで変数を復元したら、あとは通常通りにカレンダー表示年月を設定し、カレンダー計算をした後にLabelにカレンダー文字列を書き込みます。

５－２．変数再設定

図５－２の６１行目からOnTimeで呼び出されるのが図５－５です。Labelが新規作成された後で実行されます。

65. '==========　⇩(4)　変数の再設定　============
66. Private Sub setVar()
68. 　Set selectR = Selection(1)
69. 　Set addLBL = selectR.Parent.OLEObjects(selectR.Parent.OLEObjects.Count)
71. 　Set CL.LBL = addLBL.Object
72. 　Sz = addLBL.Object.Font.Size
74. 　If IsDate(selectR) Then
75. 　　Calyymm = DateAdd("d", 1 - Day(CDate(selectR)), CDate(selectR))
76. 　Else
77. 　　Calyymm = DateAdd("d", 1 - Day(Date), Date)
78. 　End If
80. 　Call makeCal
82. End Sub

図５－５

６８行目「Set selectR = Selection(1)」では、現在選択しているセル（＝日付入力セル）を変数selectRに再設定します。内容的にはLabelを作成する前の図５－２の３７行目と同じです。
６９行目「Set addLBL = selectR.Parent.OLEObjects(selectR.Parent.OLEObjects.Count)」は一番最近作成したOLEObjectを変数addLBLに再設定します。内容的にはLabelを作成する前の図５－２の５２～５３行目と同じです。
カレンダーLabelは、この直前で作成していますので、アクティブになっているシート（selectR.Parent）のOLEObjectsの中で、最も大きなインデックス（selectR.Parent.OLEObjects.Count）のものがカレンダーLabelだと考えて設定をしています。

７１行目「Set CL.LBL = addLBL.Object」は、クラスでWithEvents宣言をしたLBLオブジェクトにカレンダーLabelを割り当てています。これにより、クラス内のClickイベント（図６－２）が有効になります。
７２行目「Sz = addLBL.Object.Font.Size」は、カレンダーLabelの文字サイズを調べ、その値を変数Szに再設定します。

７４～７８行目では、表示するカレンダーの初日の日付を計算しています。選択したセルに日付が入っていればその月、空欄か日付では無い文字列の場合は今月となります。
まず７４行目「If IsDate(selectR.Value) Then」では、選択セルの値が「日付」か否かを調べています。
セル値が日付の場合は７５行目「Calyymm = DateAdd("d", 1 - Day(CDate(selectR.Value)), CDate(selectR.Value))」で、その日の初日を計算し、変数Calyymmに代入します。初日はDateAdd関数を使い「その日付の日にち分だけ戻った日付」という計算をしています。
セル値が空欄か日付では無い文字列の場合は、７７行目「Calyymm = DateAdd("d", 1 - Day(Date), Date)」で、今月の初日を計算し変数Calyymmに代入します。

８０行目「Call makeCal」では、図５－１２を呼出し、７４～７８行目で初日の日付を代入した変数Calyymmを使用してカレンダー計算をし、図５－２の５２～５３行目で作成（＝６９行目で再設定）したLabelのCaptionプロパティに設定します。これで「選択したセルの横にカレンダー」が表示されます。

図５－２の４５行目からOnTimeで呼び出されるのが図５－６です。ユーザーが選択したセルが「日付入力セル以外」だった場合に、旧カレンダーLabelが削除された後で実行されます。
引数としてLabelの文字サイズを受け取りますが、この値は「変数Szがクリアされてしまう前の値」となります。

84. '==========　⇩(5)　文字サイズ変数の再設定　============
85. Public Sub keepSz(s As Single)
87. 　Sz = s
89. End Sub

図５－６

８７行目「Sz = s」で、引数として受け取った「クリアされる前の文字サイズ値」を変数Szに再設定します。

今回OnTimeメソッドを使って以下の２ヶ所でプロシージャの呼出しを行っています。 　４５行目「Application.OnTime Now(), "'keepSz " & Sz & "'"」・・・引数有り 　６１行目「Application.OnTime Now(), "setVar"」・・・・・・・・・引数無し 呼び出される側を見てみると以下の様になります。 　８５行目「Public Sub keepSz(s As Single)」・・・・Publicプロシージャ 　６６行目「Private Sub setVar()」・・・・・・・・・Privateプロシージャ もちろん６６行目は「Public Sub setVar()」でも動きますが、８５行目は「Private Sub keepSz(s As Single)」ではエラーが発生してしまいます。 つまり「引数のあるプロシージャは「Publicプロシージャ」であることが必須　となります。 どこのサイトにも説明は見つからず、唯一Microsoftコミュニティで「なぜかPrivateだとエラーになる」という疑問があった程度です。私も理屈を考えてみたのですが、分かりませんでした。 ただ、Excelの開発タブの「マクロ」から、引数ありのプロシージャ名（プロシージャ名と引数の間に１つスペースを入れ、両端をシングルクォーテーションで括る）を入力し実行してみると、確かにPrivateは実行されず、Publicは実行されます。 しかしPrivateのプロシージャ名のみを入力し編集ボタンを押せば、そのプロシージャに飛んでいきますので「引数付のPrivateプロシージャは、認識はされているが実行は出来ない」という事になるのかもしれません。

これ以降の内容は「OLEObjectのラベルカレンダー(アドイン専用)」とほぼ同じです。御了承下さい。

５－３．文字サイズ変更

LabelCalStart（図５－２の４９行目）、及びclickCal（図５－１４の１７８行目）から呼び出される「文字サイズを変更」するプロシージャが図５－７です。引数として「文字サイズを変更する＝True、しない＝False」を受取ります。

91. '==========　⇩(6)　文字サイズ変更　============
92. Private Sub setSz(Cng As Boolean)
93. 　Dim SzArray() As Variant 　　 '←カレンダーの文字サイズデータの配列
94. 　Dim i As Integer 　　　　　　 '←カウンタ変数（配列の要素位置）
96. 　SzArray = Array(6, 9, 10.5, 12, 18, 24) 　　 '←インデックスはゼロ始まり
98. 　If Cng = True Then
99. 　　For i = 0 To UBound(SzArray, 1)
100. 　　　If Sz <= SzArray(i) Then
102. 　　　　If i = UBound(SzArray, 1) Then
103. 　　　　　Sz = SzArray(0)
104. 　　　　Else
105. 　　　　　Sz = SzArray(i + 1)
106. 　　　　End If
108. 　　　　Exit Sub
110. 　　　End If
111. 　　Next i
112. 　End If
114. 　If Sz = 0 Then Sz = SzArray(3) 　　 '←初期値サイズ
115. End Sub

図５－７

９６行目「SzArray = Array(6, 9, 10.5, 12, 18, 24) 」では、今回システムで変更できるフォントサイズを昇順に並べ、配列SzArrayにしています。今回、図５－２の５７行目で「MS ゴシック」を指定していますが、その中でもこの６種にしたのは「横サイズ＝縦サイズ÷2」のものを選んだからです。
「ラベルカレンダーをクリックし日付入力」でも文字サイズ毎の縦横サイズについて紹介したのですが、調べてみると書体が「MSゴシック」であれば「どの文字でも横幅は一緒」ですが、縦／横の比は「文字サイズで異なる」ようです。ザッと測定してみた結果が図５－８です。
この表で「横サイズ＝縦サイズ÷2」は「6, 9, 10.5, 12, 18, 24ポイントの文字」なので、今回この６種を選択しました。

図５－８

実際に各文字サイズで作ったカレンダーは図２－３です。これは図５－１０でも説明しますが「Labelのサイズに5%の余裕代」を取ったサイズにしています。 文字の横サイズが分かり易いように、余裕代がゼロの状態のカレンダーが図５－９になります。PCの画面解像度により状態が変わりますので、左側に通常のPC、右側に高解像度のPCでの結果を表します。 図５－９ まず図５－９の左側では、文字端とLabel端の隙間が微妙に異なるようにも見えますが、Labelの外枠線の太さでそのように見えているようにも思えます。ザッと見て、文字サイズ違いで横サイズは変わらない感じです。 しかし図５－９の右側では、10.5ポイントは文字列左端～Label左端の隙間がほぼ無くなっています（本来は、スペースが1つ入っている）し、9ポイントではカレンダーのレイアウトが崩れるまでになっています。つまり、9ポイント・10.5ポイントでは、文字の横サイズが、縦サイズの1/2よりも大きくなっていることが分かります。 なお、画面拡大率を変更しても状態は同じ（高解像度PCを100%表示させても、9ポイントではレイアウトは崩れる）です。 実は図５－８の表は、通常画面のPCで測ったものです。高解像度では「文字列をより多くのピクセルで表すことが出来る」ので、「9ポイント・10.5ポイントでは、縦サイズ÷2＝横サイズ」という関係式は成り立たないようです。更に高解像度のPCではどうなるか（そのようなPCを持っていないので）確かめようがありませんが、6（ピクセル）の倍数の文字サイズだけが「縦サイズ÷2＝横サイズ」なのかもしれません。（0.75というピクセルとポイントの割合から見て、3ピクセルの倍数かと思っていましたが違うようです。） 更に縦方向については、ポイント数によって文字が切れたり切れなかったりしています。この理屈については未解決です。以上のことから「カレンダーが崩れない」かつ「文字の下側が切れない」ために、図５－１０では縦横とも5%の余裕代を持たせています。解像度によってまだ不足する場合があったら、余裕の割合を増やして下さい。

９８行目「If Cng = True Then」では、引数Cng（変更する＝True、変更しない＝False）の値を調べています。変更する場合だけ、９９～１１１行目を実行します。
９９行目「For i = 0 To UBound(SzArray, 1)」は、カウンタ変数ｉを９６行目で作成した文字サイズの配列のインデックスを先頭側（＝サイズの小さい方）から回していきます。
１００行目「If Sz <= SzArray(i) Then」では、変数Sz値を配列内の値と比較しています。
変数Sz値はシステム起動直後なら初期値のゼロですが、今回システムでは起動直後にこのプロシージャを呼び出す時は引数CngにFalseを指定しているために９９～１１１行目は実行されません。引数CngがTrueになるのは、既にカレンダーが表示されている状態で「カレンダーサイズを変更するために◎印をクリック」した時です。ですので、この時点では表示済みのカレンダーの文字サイズがSz値です。
ですので、現在表示されているLabelの文字サイズを配列SzArrayの先頭（小さいサイズの方）からの値と比較をしていますので、現在値となったところで１０２～１０８行目が実行されることになります。なお不等号（<=）を付けているのは、もしユーザーがカレンダーの文字サイズを手動で変更してしまった時の対応です。

現在の文字サイズが分かったところで、１０２行目「If i = UBound(SzArray, 1) Then」では、その文字サイズが「最大値か」を調べています。
最大値だった場合は１０３行目「Sz = SzArray(0)」で、先頭の（最も小さい）文字サイズを変数Szに代入します。
最大値では無い場合は１０５行目「Sz = SzArray(i + 1)」で、次の（＝１つ大きな）文字サイズを変数Szに代入します。
新たな文字サイズが変数Szに代入されたら、１０８行目「Exit Sub」でプロシージャを抜けます。

引数Cng値がFalse（文字サイズ不変）の場合は、１１４行目「If Sz = 0 Then Sz = SzArray(3)」が実行されます。「If Sz = 0 Then」ですので、変数Sz値が初期値（ゼロ）の場合（＝システム起動直後）に「Sz = SzArray(3)」で文字サイズ12をSzに代入します（配列はArray関数で作っているので、インデックスはゼロ始まり）。
今回システムでは、カレンダーが消えても文字サイズの変数Sz値は保持しています。再び日付入力セルを選択した際には「Sz値 ≠ ゼロ」ですので、初期設定の文字サイズに戻ることなく、同じサイズのカレンダーが表示されることになります。
なお、引数CngがTrue（文字サイズ変更）なのに９９～１００行目が引っ掛からない（ユーザーがLabelの文字サイズを大きくしてしまった、または何らかの原因で変数値が消えてしまった）場合は、９９行目のFor～Nextが回りきってしまい１１４行目が実行され、サイズが初期化されることになります。

５－４．カレンダー表示位置・サイズの計算

図５－２の５０行目、図５－１６の２１２行目から呼び出される「カレンダーの表示位置・サイズを計算」するプロシージャが図５－１０です。引数は５個ありますが、受け取るのは第一引数の「選択セル位置」だけで、第２～５引数は呼び出し側に返す引数です。
プロシージャ内では、受け取った選択セル位置と、共通変数のSz値（文字サイズ）を使って表示位置と表示サイズを計算し、「T：上端位置」「L：左端位置」「H：高さ」「W：幅」の４つの引数を返します。

117. '==========　⇩(7)　カレンダー表示位置・サイズ計算　============
118. Private Sub getPos(R As Range, T As Single, L As Single, H As Single, W As Single)
119. 　L = R.Left + R.Width
120. 　T = R.Top + R.Height / 2
121. 　H = (Sz * 1.05) * 8
122. 　W = (Sz * 1.05) * 7 * 2
123. End Sub

図５－１０

位置とサイズは、図５－１１のような関係になります。選択したセルの位置は、図５－１１ではD2セルと仮定しています。

図５－１１

まず左右方向の位置は、カレンダーの左端を「選択セルの右端」にくっつけた位置にしました。そのため式は、引数として得たセル位置「R」を使用し、１１９行目「L = R.Left + R.Width」としました。
上下方向の位置は、カレンダーの上端＝選択セル上端に揃えようとも思ったのですが、揃えてしまうと「同じ行の右方向にあるセル（B2セルでカレンダーを表示した際のD2セル）がカレンダーに隠れてしまう」ため、セル高さの半分だけ下に下げました。そのため式は、１２０行目「T = R.Top + R.Height / 2」としました。

次にカレンダーのサイズです。まず文字として今回システムでは下記を使用しています。
　・フォント種類は「MSゴシック（全ての半角文字で横幅が一緒）」：図５－２の５７行目
　・フォントサイズは「横サイズ＝縦サイズ÷2」：図５－７の９６行目
１セットの文字（例えば、曜日１個とか日付１個）は、半角1～2個または全角1個で作られていますので、文字間の境界として文字セットの両脇に半角スペースを入れる事にし、半角4文字で１セットとしました。このため、１つの文字セットのサイズは「縦＝文字のポイント数、横＝文字のポイント数 × 2（＝半角文字の幅 × 4）」となります。
なお「表示カレンダーの年月」は、YYYY/MMのように半角7文字は必要なため、２セット分を使用しています。

この文字セットを、横に７個、縦に８個並べた大きさをカレンダーのサイズとします。
縦方向の根拠として、まずは１行目に表示年月とカレンダーの操作ボタンを配置し、２行目は曜日を表示させます。またカレンダー本体で最も行数が必要になるのは、初日が土曜日で最大月数の３１日となる場合なので、6行分用意すれば良いと分かります。合計して縦は8行分必要ですので、１２１行目「H = (Sz * 1.05) * 8」で８行分としています。
横方向は日曜～土曜の７日から、１２２行目「W = (Sz * 1.05) * 7 * 2」で横サイズを計算しています。

なお「よりみち」でも説明しましたが、PCの画面解像度によっては「横サイズ＝縦サイズ÷2」にならないフォントサイズがあるため、余裕代を5%取っています。

５－５．カレンダー作成

図５－５の８０行目、図５－１４から呼び出されるのが、「カレンダーの文字を組み立て、Labelの文字として貼り付ける」プロシージャ図５－１２です。

125. '==========　⇩(8)　カレンダー作成　============
126. Private Sub makeCal()
127. 　Dim i As Integer 　　　 '←カウンタ変数(曜日用､月の日付用)
128. 　Dim title_yymm As String 　 '←表示年月
129. 　Dim Wk As Integer 　　 '←曜日
130. 　Dim str As String 　　　 '←Labelカレンダーの文字列
132. 　title_yymm = String(1, Chr(32)) & Format(Calyymm, "yyyy/mm")
133. 　str = title1 & title2 & title3 & title_yymm & title4 & title5 & vbLf
135. 　For i = 1 To 7
136. 　　str = str & Chr(32) & Format(i, "aaa") & Chr(32)
137. 　Next i
138. 　str = str & vbLf
140. 　Wk = Weekday(Calyymm)
141. 　str = str & String((Wk - 1) * 4, Chr(32))
143. 　For i = 1 To Day(DateAdd("m", 1, Calyymm) - 1)
145. 　　str = str & Chr(32) & Format(i, "00") & Chr(32)
147. 　　If Wk = 7 Then
148. 　　　str = str & vbLf
149. 　　　Wk = 1
150. 　　Else
151. 　　　Wk = Wk + 1
152. 　　End If
154. 　Next i
156. 　addLBL.Object.Caption = str
158. End Sub

図５－１２

１３２行目「title_yymm = String(1, Chr(32)) & Format(Calyymm, "yyyy/mm")」では、表示カレンダーの年月を「半角で合計8文字分」の文字セットにしています。表示年月の初日（Calyymm）を使い、表示形式はYYYY/MMで7文字分ですので、先頭にスペースを１つ（String(1, Chr(32))）入れて、合計8文字分にしています。
１３３行目「str = title1 & title2 & title3 & title_yymm & title4 & title5 & vbLf」では、カレンダー１行目のスイッチ＋表示年月を作成し、変数strに代入しています。title1～5は、図５－１の２３～２８行目で定数設定した文字列です。それぞれ半角4文字分です。なお２行目に移動する「改行マーク（vbLf）」を最後に加えます。
今回カレンダーでは「閉じる（×印）」を除いた5種類を使用していますが、拡大縮小が不要な場合は×印を使用することも可能です。

１３５～１３８行目では、２行目の曜日文字を作っています。
曜日は７つありますので、１３５行目「For i = 1 To 7」でカウンタ変数ｉを７回まわします。
１３６行目「str = str & Chr(32) & Format(i, "aaa") & Chr(32)」では、1行目の文字列が格納された変数strに対して、曜日の文字列（全角1文字＝半角2文字分）と両端にスペース（Chr(32)）を加えていきます。曜日の文字は、ｉが１の時は「日（曜日）」、２の時は「月（曜日）」となりますので「Format(i, "aaa")」という式になります。なお、VBAでは「1900/1/1＝１」であり、且つ1900/1/1は（偶然にも）日曜日である事から「Format(i, "aaa")」という単純な式が成立しています。
日～土までを文字列に加えた後、１３８行目「str = str & vbLf」で３行目に移動する「改行マーク」を加えます。

１４０～１５４行目が、カレンダーの日付を作成している部分です。
まず１４０行目「Wk = Weekday(Calyymm)」で「表示カレンダー年月の初日の曜日」を取得します。日曜＝１、月曜＝２・・・という値です。
１４１行目「str = str & String((Wk - 1) * 4, Chr(32))」では、カレンダー本体の先頭部分（＝先月の日付部分）にスペースを挿入しています。
カレンダーの初日が例えば図５－１３のように土曜日だとすると、その前には６日分のスペースを空ける必要があります。空ける量は、１４０行目で計算したカレンダーの初日の曜日値から１を引いた値になります。
一方、１セットの文字列（１日分）は半角4文字ですので、（曜日値－１）× 4 という式になります。

図５－１３

１４３行目「For i = 1 To Day(DateAdd("m", 1, Calyymm) - 1)」は、カウンタ変数ｉを表示カレンダーの日数分（1日～最終日）だけ回しています。その年月の最終日は「Day(DateAdd("m", 1, Calyymm) - 1)」という「次の月の初日の１日前の日付」という計算式になります。
１４５行目「str = str & Chr(32) & Format(i, "00") & Chr(32)」では、日付（変数ｉ）を２桁表示の文字列にして、変数strに加えています。その際に数字の両脇にスペースを入れ、合計で半角4文字としています。

１４７～１５２行目では、カレンダーの横方向の位置と、縦方向の位置の移動を行っています。
横方向の位置（＝曜日）が土曜日の時には、次の日（日曜日）は１行下がると同時に一番左側に行く必要があります。またそれ以外の曜日の時には、一つ右側に移動することになります。
１４７行目「If Wk = 7 Then」では「曜日が土曜日（曜日値＝７）か」を調べ、土曜日であるならば１４８行目「str = str & vbLf」で改行マークを加えることで１行下げ、１４９行目「Wk = 1」で一番左側を示す状態値にしています。
一方、土曜日以外の場合には、１５１行目「Wk = Wk + 1」で、一つだけ右に移動させた状態値にしています。

表示月の最終日まで、カウンタ変数ｉが回り終わったら、カレンダー内容は全て変数strに代入されたことになりますので、１５６行目「addLBL.Object.Caption = str」で、「カレンダーLabel」のCaptionプロパティに設定することで、カレンダーとして表示されます。

５－６．カレンダー上の操作

ユーザーがカレンダーLabel上をクリックした時には、図６－２「LBL_MouseDown」イベントが発生し、その中の２２８行目から呼び出されるのが図５－１４です。引数として、Label上のどこをクリックしたかの座標x、y（単位：ポイント）を受取ります。

160. '==========　⇩(9)　カレンダー上の操作　============
161. Public Sub clickCal(x As Single, y As Single)
162. 　Dim allStr As String 　 '←Label内の全文字列
163. 　Dim uniStr As String 　 '←切り出した文字列
165. 　x = Int(x / (Sz / 2))
166. 　y = Int(y / Sz)
168. 　allStr = addLBL.Object.Caption
169. 　allStr = Replace(allStr, vbCrLf, "")
170. 　allStr = StrConv(allStr, vbFromUnicode)
171. 　uniStr = MidB(allStr, (Int(x / 4) * 4) + (y * 7 * 4) + 1, 4)
172. 　uniStr = StrConv(uniStr, vbUnicode)
174. 　Select Case y
175. 　　Case 0
176. 　　　Select Case uniStr
177. 　　　　Case title1 　 '◎
178. 　　　　　Call setSz(True)
179. 　　　　　Call setPos
180. 　　　　Case title2 　 '<<
181. 　　　　　Calyymm = DateAdd("yyyy", -1, Calyymm)
182. 　　　　　Call makeCal
183. 　　　　Case title3 　 '<
184. 　　　　　Calyymm = DateAdd("m", -1, Calyymm)
185. 　　　　　Call makeCal
186. 　　　　Case title4 　 '>
187. 　　　　　Calyymm = DateAdd("m", 1, Calyymm)
188. 　　　　　Call makeCal
189. 　　　　Case title5 　 '>>
190. 　　　　　Calyymm = DateAdd("yyyy", 1, Calyymm)
191. 　　　　　Call makeCal
192. 　　　　Case title6 　 '×
193. 　　　　　Call LabelCalStart(selectR, False)
194. 　　　End Select
196. 　　Case Is > 1
197. 　　　If Not (Trim(uniStr) = "" Or x >= 7 * 4) Then
198. 　　　　selectR.Value = Calyymm + Trim(uniStr) - 1
199. 　　　　Call LabelCalStart(selectR, False)
200. 　　　End If
201. 　End Select
203. End Sub

図５－１４

１６５行目「x = Int(x / (Sz / 2))」は、引数として受け取ったx座標値（横方向の位置）を「Sz / 2（半角文字の幅）」で割った「左端からの文字位置」です。整数になるようにIntで小数点以下を切り捨てています。
１６６行目「y = Int(y / Sz)」は、引数として受け取ったy座標値（縦方向の位置）を「Sz（半角文字の高さ）」で割った「上端からの文字位置」です。x、yともゼロ始まりとなります。

１６８～１７２行目では、クリックした位置の文字セットを切り出しています。
１６８行目「allStr = addLBL.Object.Caption」は、カレンダーLabelの全ての文字列（改行マークも含め）を変数allStrに代入します。
続けて１６９行目「allStr = Replace(allStr, vbCrLf, "")」では、改行マーク「vbCrLf」を「""（長さゼロの文字列）」に置き換え、改行を削除しています。

気が付かれた方もいるかもしれませんが、図５－１２の１３３行目などでは「改行マーク」として「vbLf」を使ってカレンダー文字列を組み立てています。一方、１６９行目で「改行マーク」を削除するときには「vbCrLf」を使用しています。 一見プログラムミスのように見えますが、結果は大丈夫です。 調べてみると、改行マークにvbLfを使って文字列を組み立てた後、それをLabelのCaptionプロパティに設定した時に、自動的にvbLf → vbCrLfへと変換されるようです。ちなみに文字列組み立て時にvbCrLfを使用した時には、そのままの状態でCaptionプロパティに設定されます。 「自動的に」というのは便利なようですが、理解していないと不安でしかありません。かと言って単純に「同じものを加減」するのが良いと信じ込むのも問題です。「vbCrLfで文字列を組み立て、削除時もvbCrLfを削除」とすればセーフですが、「vbLfで文字列を組み立て、削除時もvbLfを削除」とすればアウト（＝１文字ずつズレてしまう）です。 一工程ずつ結果を確かめながら進めて行く　しか無いのだと思います。

１７０行目「allStr = StrConv(allStr, vbFromUnicode)」では、Excel特有のUnicode（UTF-16：半角でも全角でも２バイト使用）からShift-JIS（半角＝１バイト、全角＝２バイト）に変換しています。
これは、カレンダー内には全角の文字（◎印など）と半角文字（>印や数字）が混ざっていますので、クリックした文字セットを正確に把握するためには、全角と半角の文字数を正しく数える必要があるからです。

１７１行目「uniStr = MidB(allStr, (Int(x / 4) * 4) + (y * 7 * 4) + 1, 4)」で、クリックした位置の文字列を切り出しています。切り出し始めの位置は「(Int(x / 4) * 4) + (y * 7 * 4) + 1」で、横方向は「Int(x / 4) * 4」と「１セット（＝半角4文字）の先頭」を計算し、縦方向は「(y * 7 * 4)」で行の全文字数を足します。なお、切り出し位置は「１始まり」なので「＋１」だけ値をずらします。
切り出す文字数は１セット分「4文字」ですので、MidBの第三引数は「4」になります。

１７２行目「uniStr = StrConv(uniStr, vbUnicode)」では、Unicodeに戻しています。

１７４行目「Select Case y」では、１６６行目で計算した「カレンダー内の何行目をクリックしたか」の「y値（ゼロ始まり）」を使って、「カレンダー１行目（Y＝0）の制御ボタン類をクリック」したのか、または「３行目以降（Y > 1）の日付部をクリック」したのかを仕訳けています。
なお、2行目の曜日文字（Y = 1）は、ここでは拾い上げてくれないので、クリックしても無反応となります。

１７５行目「Case 0」は、制御ボタンの行をクリックした時です。
１７６行目「Select Case uniStr」では、更に１７２行目で取得した「クリックした文字セット」を調べています。

１７７行目「Case title1」は、クリックしたのが定数title1（◎印）だった時です。その時には１７８行目「Call setSz(True)」で図５－７を呼出します。引数にTrueを指定していますので、文字サイズを１つ大きなサイズに変更（現在が最大サイズの時には、最小サイズに変更）しています。
そして１７９行目「Call setPos」で図５－１６を呼出し、カレンダーLabelのサイズのみを変更しています。

１８０～１９１行目は、クリックしたのがtitle1～title5（<<印（１年戻る）、<印（１ヶ月戻る）、>印（１ヶ月進む）、>>印（１年進む））の時に実行される部分です。それぞれDateAdd関数を使って「現在のカレンダーの年月日（Calyymm）」から目的の年月日に移動した日付を計算し、変数Calyymmに再代入します。その後で「Call makeCal」で図５－１２を呼出し、「カレンダーの中身を入れ直し」ます（Label自体は位置・サイズとも不変です）。

１９２行目「Case title6」は、クリックしたのが定数title6（×印）だった時です。今回のシステムでは定数宣言だけ行っており、実際のカレンダーには盛り込んでいません。もしカレンダーの拡大縮小が不要な場合には、◎印の代わりに×印を表示すれば「カレンダーを消す」機能になります。
その場合は、１９３行目「Call LabelCalStart(selectR, False)」で図５－２を「第二引数＝False」で呼び出し、「日付入力セル以外（＝カレンダーを表示しないセル）」が選択されたことにして、カレンダーを消しています。

１９６行目「Case Is > 1」は、縦方向で日付行（３行目以降）をクリックした時の処理です。
１９７行目「If Not (Trim(uniStr) = "" Or x >= 7 * 4) Then」の１つ目の条件式「Trim(uniStr) = ""」は、クリックした場所が「日付では無い（＝スペースだけ）」場合以外（Not）です。そして２つ目の条件式「x >= 7 * 4」は、カレンダー右端部をクリックした時の無効化です。

今回、文字サイズの縦横比が「完全に2:1」では無いので、PCによってはカレンダーの右端部が切れる（＝次の行に文字が回る）現象が発生します。そのため図５－１０の１２２行目「W = (Sz * 1.05) * 7 * 2 」で「5%の余裕代」を持たせています。
そうなると、例えば図５－１５で「1月1日」の右の方をクリックした時、その位置が余裕代だった場合は、１７１行目「uniStr = MidB(allStr, (Int(x / 4) * 4) + (y * 7 * 4) + 1, 4)」の計算式で得られる値は「 02 」という値になってしまいます。つまり「1を選択したはずが、次の2を選択した事になる」のです。

図５－１５

そのため１９７行目の２つ目の条件式「x >= 7 * 4」で「余裕代をクリックしたら無視」することにしました。なお、文字サイズをもっと絞って「Labelの余裕代は不要」の状態にしておけば、この２つ目の条件式は不要になります。

これでクリックしたのが日付の部分のみ　となりますので、１９８行目「selectR.Value = Calyymm + Trim(uniStr) - 1」で、日付文字（uniStr）の両端からTrimでスペースを削除し、表示カレンダーの初日（Calyymm）と足し合わせることで「クリックした日付値」を計算し、ユーザーが選択したセル位置（selectR）に貼り付けます。
なお、右辺は「全て数値（日付）の計算」とExcel側が勝手に判断してくれるので、例えば「01」という文字列は「1」と解釈してくれます。気持ち悪い方は「CInt(Trim(uniStr))」等と数値変換をして下さい。

最後に、「カレンダーは不要」になりましたので、１９９行目「Call LabelCalStart(selectR, False)」で図５－２を「第二引数＝False」で呼び出し、「日付入力セル以外（＝カレンダーを表示しないセル）」が選択されたことにして、カレンダーを消しています。

５－７．カレンダーサイズの変更

図５－１４の１７９行目から呼び出される「カレンダーの中身は不変で、サイズのみ変更」するのが図５－１６です。

205. '==========　⇩(10)　カレンダーサイズの変更のみを実行　============
206. Private Sub setPos()
207. 　Dim T As Single 　 '←カレンダーのTop位置
208. 　Dim L As Single 　 '←カレンダーのLeft位置
209. 　Dim H As Single 　 '←カレンダーの高さ
210. 　Dim W As Single 　 '←カレンダーの幅
212. 　Call getPos(selectR, T, L, H, W)
214. 　With addLBL
215. 　　.Height = H
216. 　　.Width = W
217. 　　.Object.Font.Size = Sz
218. 　End With
220. End Sub

図５－１６

２１２行目「Call getPos(selectR, T, L, H, W)」では、図５－１０を呼出し、セル位置（selectR）と変数Sz値（１７８行目でSetSz(True)を実行することで、変数Sz値の変更は完了している）で、表示するLabelの位置・サイズを計算します。
計算した結果は、第２～５引数（T, L, H, W）で得られます。

２１４行目「With addLBL」以下で、表示済みのカレンダー（addLBL）についてのプロパティ変更を行います。
２１５行目「.Height = H」でカレンダーLabelの高さを変更し、２１６行目「.Width = W」で幅を変更します。なお選択しているセル位置は変わらないため、２１２行目で受け取った「T（上下方向位置）、L（左右方向位置）」については不変となり、再設定はしていません。
２１７行目「.Object.Font.Size = Sz」ではカレンダーLabelのフォントサイズを変数Sz値に変更しています。
以上でカレンダーのサイズが変更になり、それに合わせて文字サイズも変更されます。

６．クラスモジュール（Class1）

クラスモジュールの先頭では、作成したカレンダーLabelのイベントを取得できるようにWithEventsの宣言をしています。

222. '==========　⇩(11)　WithEventsの宣言　============
223. Public WithEvents LBL As MSForms.Label

図６－１

そして、そのカレンダーLabel（LBLオブジェクト）のMouseDownイベントプロシージャが図６－２です。
引数としては、第一・第二引数でマウスやキーボードのどのボタンが押されているかを受け取り、また第三・第四引数でマウスをクリックした「カレンダーLabel上の位置（XY座標）」を受け取ります。

225. '==========　⇩(12)　カレンダーLabelのクリックイベント　============
226. Private Sub LBL_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
227. 　　　　　　　　　　　　　　　ByVal x As Single, ByVal y As Single)
228. 　Call clickCal(x, y)
229. End Sub

図６－２

２２８行目「Call clickCal(x, y)」で、図５－１４を呼出し、引数として渡す「カレンダーLabel上のXY座標値」を元にして「カレンダー上のどの文字セットをクリックしたか」を判断しカレンダーを操作します。

７．アドインとしてExcelにマクロを登録

このマクロ付ファイル（サンプルファイル）をExcelのアドインに登録することで、今回の「ラベルカレンダー」を他のブックから呼び出して使うことが出来ます。アドイン方法については「年賀状リスト等の宛名検索と追記　アドイン登録」を参照下さい。
なお、ボタンを押して何かを実行するシステムではないので、「アドイン保存したファイル名を有効にする」まででOKです。

８．最後に

前回ラベルカレンダー「ラベルカレンダーをクリックし日付入力」を作った時は、カレンダー日付の並びを配列の形として持ち、クリックした位置から配列の位置を計算し、その配列の要素（＝日付）を取得する方法を取りました。今回はラベルの文字そのものを切り出すという手法にしましたが、今回の方が楽だな　という印象です。
また前回はスペースの横幅が制御できず、やむなくTABを使用した経緯がありました。同じラベルなのになぜ前回ダメだったのか・・・もしかしたら私の勘違いだったのか、またはOLEObjectだからなのかの検証はまだ出来ていません。これは宿題とさせて下さい。

図５－９で「9ポイントだと高解像度ではカレンダーレイアウトが崩れる」と説明しましたが、高解像度で「9ポイント」のカレンダー日付を選択する時、少し右側をクリックしてしまうと「次の日が選択」されたり、余裕代の分と判断されて「日付が確定されない」という現象が発生します。作った後に言うのもなんですが、高解像度を採用しているPCがある場合は、9ポイント・10.5ポイントは使わない方が良いかもしれません。
または、解像度と文字の縦横比を詳しく調べて、そのデータをカレンダーサイズに反映して・・・という方法も考えられますが、面倒そうなので今回は手を抜きました。

今回システムは、OnTimeを使った今回の項のExcel（it-080.xlsm）を先に作りました。OLEObject作成による変数クリアには困りましたが、何とかOnTimeで変数復活することが出来ました。しかし他のマクロが裏で動いていたらNGです。人間の操作よりも早くマクロが動いてくれているので成立しているシステムです。基本的には「OLEObjectのラベルカレンダー(アドイン専用)」の方を使用するのが安全だと思います。


OLEObjectのラベルカレンダー(同一ブック内)（it-080.xlsm）

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