2020/02/19

図形も貼り付けられるスケジュール帳




１．スケジュール帳作成の経緯

２０年くらい前、一緒に仕事をする仲間のために「矢印や吹き出しも描けるスケジュール帳」を作りました。当時はExcel95だった気がします。結局ほとんどの人には見向きもされませんでしたが、１人だけは気に入ってくれたようで、長くずっと使ってくれていました。
今は各人がスマホを持ち、多機能なスケジュールアプリがあふれている時代です。今更このようなものは珍しくないでしょうが、Excelで図形とセルを同時に扱う難しさという点で紹介したいと思います。

２．概要と全体の流れ

図２－１の通り、スケジュール帳は一週間単位で日曜～土曜を縦に並べてあり、１日は３行にしてあります。思惑としては「午前、午後、夜」の３つに分けているつもりで、一週間２１行でちょうど１画面くらいになりそう　と考えました。


図２－１

スケジュール記入欄の上にスクロールバーを配置し、左右に動かすことで次週・前週などのスケジュール画面に移動することができます。
スケジュール記入欄では、セルに文字を入力するのはもちろん、色で仕訳けたり、アドレスを貼り付けたり、また画像や図形を貼り付けたりできます。なお、図形は記入範囲の太枠内に収めることを前提とし、図形がはみ出すと忠告を出します。これについては、３項で説明します。

プログラムの流れは図２－２の通りです。尚、現在表示されている画面の日付をA、次に表す画面の日付をBとしています。

図２－２

記入するのはSheet1に作ったスケジュール記入欄エリアで、そのデータを保存するのはSheet2のＡ列にしました。記入⇔保存は１週間単位の画面コピペで行っていますので、保存には記入欄エリアと同じ２１行／週　ｘ　保存週 を使用します。

３．メインプログラムの説明

まず、Sheet1の記入欄範囲の左側に「年・月日・曜日」が縦に並んでいますが、これは図３－１のようにワークシート関数が記入されています。セルＢ２の日付データ（図３－１では数式表示の為、シリアル値になっています）を元に、年・月日が計算されるようにしています。

図３－１

次に、スクロールバーの設定ですが、図３－２のように調整するのは「LargeChange」「Max」「Min」「SmallChange」「Value」の５項目です。Max・Minを ±5 にしたのは、「大きく動かしても1か月(約5週間)だろう」と考えたからです。1年先・1年前に飛びたいという要求があるようでしたら±50くらいを設定するようでしょう。尚、Value値はゼロにします。

図３－２

スケジュール帳の記入欄部分は Sheet1 に作り、マクロも Sheet1 に記載しています。
まずはメイン部分について図３－３に示し、１つ１つのコードの説明をします。そして、そのメインから呼び出されるサブプロシージャをその後の４項で説明します。
  1. '==========　⇩①　変数・定数宣言　 =================
  2. Dim　Bar_0　As　Boolean　　　　　　 '←ｽｸﾛｰﾙﾊﾞｰのValue値をｾﾞﾛに戻した時の再表示を防止するﾌﾗｸﾞ
  3. Dim　Memo_Range　As　Range　　　　 '←ｽｹｼﾞｭｰﾗ記入範囲を表すRange変数
  4. Dim　Save_Top　As　Range　　　　　 '←ｽｹｼﾞｭｰﾗを保存する位置の先頭を表すRange変数
  5. Const　Start_Day　As　Date　=　#12/29/2019#　　 '←ｽｹｼﾞｭｰﾗの開始週（日曜日）
  6. Const　End_Day　As　Date　=　#1/6/2030#　　　　 '←ｽｹｼﾞｭｰﾗの最終週（日曜日）
  7. '===========　⇩②　スケジュール記入範囲、保存範囲の設定　 ===============
  8. Public　Sub　Range_Set()
  9. 　Set　Memo_Range　=　Sheets("sheet1").Range(Cells(3,　3),　Cells(23,　3))　　 '←記入範囲を指定
  10. 　Set　Save_Top　=　Sheets("sheet2").Range("a1")　　　　 '←保存範囲の先頭セルを指定
  11. End　Sub
  12. '============　⇩③　スクロールバー値を変更した時に動くプロシージャ　 ===========
  13. Private　Sub　ScrollBar1_Change()
  14. 　Application.ScreenUpdating　=　False　　 '←動作速度を向上させる為､画面更新を止める
  16. 　If　Bar_0　=　True　Then　Exit　Sub　　　 '←ｽｸﾛｰﾙﾊﾞｰのValue値をｾﾞﾛに戻した時には実行しない
  17. 　If　Memo_Range　Is　Nothing　Then　Range_Set　　 '←起動時にMemo_Range値が設定されていない場合は設定
  18. 　If　Shape_Group_XOR(Memo_Range)　=　0　Then　GoTo　Value0　 '←枠線に掛かる図形があれば中止
  20. 　Dim　Next_Week　As　Date　　　　　 '←次に表示する週の初日値
  21. 　Dim　This_Week　As　Date　　　　　 '←現在表示されている週の初日値
  22. 　Dim　Save_Range　As　Range　　　　 '←現在表示されている週のﾃﾞｰﾀを保存する範囲
  23. 　Dim　New__Range　As　Range　　　　 '←次に表示する週のﾃﾞｰﾀが保存されている範囲
  24. 　Dim　Save_Cell_Top　As　Long　　　 '←保存ﾃﾞｰﾀ範囲の行位置（現在表示されている週）
  25. 　Dim　New__Cell_Top　As　Long　　　 '←保存ﾃﾞｰﾀ範囲の行位置（次に表示する週）
  27. 　This_Week　=　Sheets("sheet1").Cells(2,　2).Value　　　 '←現在表示されている週の初日値
  28. 　Next_Week　=　This_Week　+　ScrollBar1.Value　*　7　　　　 '←次に表示する週の初日値
  30. 　If　Next_Week　<　Start_Day　Then　　　　 '←ｽｸﾛｰﾙﾊﾞｰで指示した週が設定初日週より前だったら
  31. 　　Next_Week　=　Start_Day　　　　　　　 '←次に表示する週は設定初日週にする
  32. 　ElseIf　Next_Week　>　End_Day　Then　　　 '←ｽｸﾛｰﾙﾊﾞｰで指示した週が設定最終日週より後だったら
  33. 　　Next_Week　=　End_Day　　　　　　　　 '←次に表示する週は設定最終日週にする
  34. 　End　If
  36. 　Save_Cell_Top =　(This_Week　-　Start_Day)　/　7　*　Memo_Range.Rows.Count　　　　　 '←週の数 ｘ 行数/週
  37. 　Set Save_Range =　Save_Top.Offset(Save_Cell_Top,　0).Resize(Memo_Range.Rows.Count)　 '←保存週のｾﾙ範囲を計算
  38. 　New__Cell_Top =　(Next_Week　-　Start_Day)　/　7　*　Memo_Range.Rows.Count　　　　　 '←週の数 ｘ 行数/週
  39. 　Set New__Range =　Save_Top.Offset(New__Cell_Top,　0).Resize(Memo_Range.Rows.Count)　 '←表示週のｾﾙ範囲計算
  41. 　Call　Shape_Cut(Save_Range)　　　 '←保存週の範囲にある図形を削除
  43. 　Call　Cell_Width(Memo_Range,　Save_Range)　　　 '←保存先の列幅を記入幅よりも広くする
  45. 　Call　Copy_Paste(Memo_Range,　Save_Range)　　　　 '←記入範囲をCopyし、保存範囲にPasteする
  46. 　Save_Range(1).Offset(0,　1)　=　This_Week　　　　 '←保存範囲の右肩部に日付を記入
  48. 　Call　Shape_Cut(Memo_Range)　　　　 '←記入範囲にある図形を削除する
  50. 　Call　Line_Draw(New__Range)　　　　 '←新しく表示した週が初表示の時に日毎の線を入れる
  52. 　Call　Copy_Paste(New__Range,　Memo_Range)　　　 '←保存範囲をCopyし、記入範囲にPasteする
  53. 　Sheets("sheet1").Cells(2,　2).Value　=　Next_Week　　 '←1週間の日付の元ﾃﾞｰﾀ部に日付を記入
  55. Value0:　　　　　　　　　　　　　　 '←枠線に図形が掛かっていた時に飛んでくる先
  56. 　Bar_0　=　True　　　　　　　　　　 '←ｺﾝﾄﾛｰﾙﾊﾞｰを動かした時に登録ﾏｸﾛを作動させない
  57. 　　ScrollBar1.Value　=　0　　　　　 '←ｽｸﾛｰﾙﾊﾞｰの値(Value値)をｾﾞﾛにしてﾊﾞｰを中央に戻す
  58. 　Bar_0　=　False　　　　　　　　　 '←ﾊﾞｰを動かした時に登録ﾏｸﾛが動く様にする
  60. 　Application.ScreenUpdating　=　True　　　 '←画面更新をする(新しい週を表示させる)
  62. 　If　Next_Week　=　Start_Day　Then　　　 '←表示週が設定初日週だったらｺﾒﾝﾄを出す
  63. 　　MsgBox　"スケジューラ初日週です"
  64. 　ElseIf　Next_Week　=　End_Day　Then　　 '←表示週が設定最終日週だったらｺﾒﾝﾄを出す
  65. 　　MsgBox　"スケジューラ最終週です"
  66. 　End　If
  67. End　Sub
図３－３

３－１．変数・定数宣言部

①の２～６行目は、全体で使用する変数・定数を宣言・設定しています。
２行目は、フラグ変数です。スクロールバーで表示週を変更した後にスクロールバーを中立に戻す処理をしています（次の表示週変更操作に対応できるようにする為）が、中立にする（Value値をゼロにする）事により、「スクロールバーの値が変更された」と判断されて、スケジュール帳の再表示処理が自動的に入ってしまいます。
そこでマクロ側でValue値をゼロに変更する時には、フラグ「Bar_0」をTrueにし表示操作中止させています。

３～４行目のMemo_Range変数、Save_Top変数は、それぞれスケジュール帳の記入欄のセル範囲、保存シート（今回はSheet2）の保存領域の先頭セル位置　を変数として宣言しています。本来は定数として設定したいのですが、Rangeは定数として宣言できません。アドレスを文字列として定数にする方法もあるでしょうが、コードが複雑になりそうでしたので、今回はこのような設定としました。

５～６行目は、開始週・最終週の日付を定数として宣言しています。日付を定数宣言する場合は日付の両端に＃をつけますが、例えば「＃2019/12/29＃」と入力しても勝手に５～６行目の様な書式に変更されます。
保存先であるSheet2は、最近のExcelであれば100万行以上ありますので、ざっと900年保存できますので最終週の定数はあまり意味がありません。一方、保存データは1行目から保存させていますので開始週は必要になります。昔のスケジュールを記入する場面は少ないと思いますが、シートの真ん中辺りから保存するようにすれば、開始・終了の制限は実質必要なくなるかもしれません。

３－２．スケジュール記入範囲、保存範囲の設定

②の８～１１行目は、スケジュール記入範囲・保存範囲の設定プロシージャです。
スケジュール記入範囲は、今回は Sheet1のC3～C23セルに設定し、この範囲内に図形等を含めたスケジュールを記入します。また保存範囲はSheet2のＡ列に設定し、変数であるSave_Topにはその先頭セルを代入しています。
この変数はRange型なので、変数宣言は宣言部でしても、どこかのプロシージャ内でないと値は代入できません。通常はファイルを開いた時に実行されるWorkbook_Open イベントプロシージャに記述する事が多いと思いますが、Workbook_Open で記述するという事は、コードを「ThisWorkbook」側と「Sheet1」側に分けて書くことになります（スクロールバーの登録マクロは Sheet1 に書かざるを得ませんので）。つまり異なるモジュール間で変数をやり取りすることになるので、どうしても Public変数を使う事になります。
また、メインコードをThisWorkbookに記述したとしても、スクロールバーの登録マクロはSheet1になりますので、Public　Sub で記述するプロシージャが出てきます。
「なんでPublicを使ったらいけないんだ？」と思われるかもしれませんが、「変数・プロシージャはできるだけ狭い範囲で使う」が原則です。今回の場合はBookに１つの機能しか入れていませんが、複数の機能を入れた場合には異なる機能側から余計な変数やプロシージャが見えてしまう事になるので、間違いの元になります。
ということで、今回は「スクロールバーを操作する」というイベントを発生出来るものがありますので、その操作の時（１７行目）に代入する事にしました。
また、この文章を書いていて思い出した事があります。以前、何らかのエラーでマクロが中断してしまった時の対応として、画面上に「リセット」というボタンを作り「動かなくなったら、このボタンを押してね」といって変数値などを再読み込みさせる手段を取っていた事がありました。今考えれば自分の手抜きを人に押し付けていたと反省していますが「必要になったら読み込み」なら許してもらえるかも、と思っています。

３－３．スクロールバーを動かした時の処理

③の１３～６７行目は、スクロールバーを動かし、Value値が変更になった時に作動するプロシージャです。
まず１４行目の「Application.ScreenUpdating　=　False」は、処理時間が多くかかる画面更新を一時停止させるものです。マクロの処理過程は見えなくなりますが、処理時間は短くなります。
マクロ処理が終われば自動的に画面更新されますが、明示的に６０行目の「Application.ScreenUpdating　=　True」で画面更新させています。

１６行目は、画面再表示防止をしています。スクロールバーを動かしたことにより表示週変更の処理を行った後、スクロールバーを中立位置にするために５７行目でValue値をゼロにしていますが、その処理が「スクロールバーの値をゼロに変更した」と判断されて、再び１３行目からのプロシージャを動かそうとします。５７行目の１つ前で「変数 Bar_0」にTrue を設定していますので「Value値をマクロでゼロにした時は、１６行目で表示週変更の処理から抜けだす」ことになります。
「変数 Bar_0」はBoolean型なので規定値はFalse(＝ゼロ)です。ユーザが最初にスクロールバーを動かした時には「Bar_0 = False」ですので、処理はもちろん正常に動作します。

１７行目は、スケジュール帳記入欄の範囲を示す変数 Memo_Range が空（Rangeオブジェクトなので、 "" では無くIs Nothing ）の時に８～１１行目のRange_Setプロシージャを実行し、記入範囲・保存範囲を記憶させます。ファイルを開き、最初にスクロールバーを動かした時に実行されます。

１８行目は、スケジュール記入欄範囲（Ｃ３：Ｃ２３）の枠に跨った格好で図形が存在した場合に、注意を促すメッセージボックスを表示しマクロを終了します。「Shape_Group_XOR()」は自作の関数で、引数としてセル範囲（今回は、スケジュール記入欄範囲）を渡すと、その外枠上に図形が存在するか否かを確認し、存在するならばゼロを返すようにしてあります。
抜け出す先は「Value0」という５５行目であり、「Exit Sub」ではありません。スクロールバーは既に動かされてしまっている為、Value値をゼロに戻しておかないと次の操作の時に支障が出るために、飛び先 Value0 以降で Value値をゼロに戻しています。

２０～２５行目は、このプロシージャの中で使用する変数の宣言です。
「Next_Week」は次に表示する週の初日値、「This_Week」は現在表示されている週の初日値を表します。また「Save_Range」は現在表示されている週のﾃﾞｰﾀを保存する範囲、「New__Range」は次に表示する週のﾃﾞｰﾀが保存されている範囲です。その関係を図３－４で示します。
また、Save_Cell_Top、New_Cell_Topは、保存シートの先頭からの距離です。（尚、この２つの変数は必須ではなく、３７、３９行目の式を見易くするために設定しました）


図３－４

２７～２８行目では、現在表示週と次に表示する週の日付を取得しています。
２７行目は現在表示されている週の初日（日曜日）を代入しているのですが、その値（日付）は「Sheet1のＢ２セル」から読み取ります。これはデータをSheet2からコピーしてSheet1の記入範囲に貼り付けた（５２行目）後、５３行目で表示した週の日付を貼り付けているから、Ｂ２セルには表示週の初日値が書かれている訳です。
また２８行目の「次に表示する週の日付」は、１行上で取得した表示週日付に対し、スクロールバーで動かした週の数だけズラす計算をしています。週は７日なので、スクロールバーの値に「７」を掛けています。

３０～３４行目は「次に表示する週の修正」です。スクロールバーは「開始週」や「最終週」に関係無く動かせますので、もし設定した値が開始週や最終週をオーバーしていた時に開始週・最終週に戻す処理です。

３６～３９行目は、図３－４の保存シート（Sheet2）側の「保存先（＝現在の表示週　Save_Range）」と「次の表示週　New_Range」の位置・範囲を計算しています。
保存先であるSheet2は、先頭行からデータを保存しています。つまり先頭にはStart_Day 週のデータを置いてありますので、その差分と１週間の行数から該当するセル位置を計算させています。またその範囲は、先頭行（＝Save_Top）からOffsetで行位置をズラした後、セル範囲を記入範囲分に広げています。

４１行目からが、データをコピペしている部分です。

４１行目では、図２－２でも説明しましたが、コピペをする前に図形を削除する工程を入れています。削除したい範囲「Save_Range」を引数で渡しています。
コピペをする前に貼り付け先の図形を削除する必要性ですが、コピー元に図形が存在する状態でコピーすると、図形もコピーされて貼り付け先に図形も貼り付きます。セルの値は書式も含めて貼り付け先に上書きされるのですが、貼り付け先に図形が存在していると貼り付けるときに元の図形が消えないので、コピー元の図形 ＋ 貼り付け先の図形が重なった形になります。
セルの値も図形も全てを更新しないと意味がありませんので、自動的には消せない図形をまず削除しているのです。

４３行目は「保存先の列幅を記入幅よりも広く」する操作をしています。
スケジュール記入画面（Sheet1）のセル幅は、ユーザが自由に変更できます。セル幅をユーザが広げてしまった時には、記入画面のセル幅（今回はSheet1のC列）の方が保存シートのセル幅（今回はSheet2のA列）よりも広くなります。すると保存をした場合にSheet2のA列からはみ出して保存されるオブジェクトが出てきます。（調べ切れていないのですが、列の右端に置いた図形が保存側の列の右端に貼り付く形で配置されるのが原因の様です）
また幅をユーザが狭くしてしまった時には、保存されていた図形が記入画面の端にへばりついてしまい、記入した時のレイアウトが崩れてしまいます。（こちらの対策は積極的に行っていませんが、図形が枠線を跨っていると人手で動かすことが出来ます。）
この不具合を避けるために、保存先の列幅は常に記入幅よりも同等以上にする機能をつけました。改造して、列幅をロックするような仕様にすれば不必要になると思います。

４５～４６行目で、現在表示されている画面を保存シート側に保存します。同時に保存シートの右肩部に保存したデータの日付を記入しています。
コピー元の範囲（今回は Memo_Range）を第一引数で、貼り付ける範囲（今回は　Save_Range）を第二引数で渡しています。
保存シート側に日付を入れる意味ですが、新規の画面を表示した際に日付の境目である罫線を入れる（５０行目のLine_Draw）ためです。

４８行目では引数に「Memo_Range」を渡して、Sheet1のスケジュール記入欄範囲にある図形を削除しています。これは、４１行目と同じ様な理由です。

５０行目ですが、引数の「New__Range」の右肩部に日付がなかった時に、日付分割用に３行ごとに罫線を引いています。
これは４６行目で「保存シートの右肩部に保存したデータの日付を記入」していますので、「日付が入っている ＝ 使用されたことがある ＝ ユーザが罫線を加工しているかもしれない」事から、「日付の無いデータのみ罫線を引いて」います。

５２～５３行目は、コピー元の範囲（今回は New_Range）を第一引数で、貼り付ける範囲（今回は　Memo_Range）を第二引数で渡し、保存側（Sheet2）から記入側（Sheet1）へコピペをしています。その際、記入範囲左側の日付（計算式）の元データとなる週の初日日付をＢ２セルに書き込んでいます。

５５行目の「Value0：」は、GOTO で飛ばす先の「行ラベル」です。１８行目で記入枠に図形が跨っている時には、５５行目に飛んでくるようにしています。
もし図形が跨ってコピペの処理をしなかったとしても、スクロールバーの位置を元に戻さなければならないために Value値をゼロにする処理だけはしておきます。
５７行目は、そのスクロールバーのValue値をゼロに戻す命令です。しかしゼロに戻すと「スクロールバーの値を変更した」と判断して登録しているマクロ「ScrollBar1_Change」を実行しようとします。記入側シート（Sheet1）と保存側シート（Sheet2）の間で同じ週のデータをコピペするだけなので表面上は変化ありませんが、無駄な工程です。
その工程を中断させるために、Value値をゼロにする直前（５６行目）でフラグの役目をしている変数Bar_0をTrueにしています。このフラグにより、一旦「ScrollBar1_Change」を実行しても１６行目で抜け出してくれます。抜け出して戻ってきたら58行目でBar_0を規定値のFalseに戻します。

６０行目では、１４行目からの画面更新ストップを解除し、画面更新（＝新しい週のデータに切り替わっている）されます。

６２～６６行目は、新しく表示した週が「スケジュール表開始週」または「最終週」であった時に、そのコメントをMsgBoxで出します。
MsgBoxなので「OKボタン」を押さないと、スケジュール記入・スクロールバー操作は出来ません。Msgboxの代わりに図３－５の様な「Windows Scripting Host」のPopupメソッドを使用すると、自動的（図３－５の例では1秒後）にメッセージが消えますので、状況によって使い分けて下さい。
  1. '======= ６３行目の代わりに使うとした場合　 ================
  2. Dim WSH As Object
  3. Set WSH = CreateObject("WScript.Shell")　　 '←Windows Scripting Hostをｵﾌﾞｼﾞｪｸﾄとして取得
  4. WSH.Popup "スケジューラ初日週です", 1, "", vbExclamation　　　　 '←Popupメソッドを実行
  5. Set WSH = Nothing
図３－５

また別な方法として、図３－６の様にUserFormにコメントを書いておき、表示している時間を制御する方法もあります。尚、この場合はShowメソッドの引数としてvbModeless（値としてはゼロ）を指定して下さい。規定値のvbModal （または、引数を設定しない）では次のコードへ進んでくれず、UserFormが表示されっぱなしになります。
  1. '======= ６３行目の代わりに使うとした場合 （UserForm1 には､コメントが書いてあるとして） ======
  2. UserForm1.Show 0　　　　　 '←必ずvbModeless 又は 0　を指定
  3. Application.Wait (Now + TimeValue("0:00:01"))
  4. UserForm1.Hide
図３－６

４．サブプログラムの説明

３項のメインプログラムから呼び出されて実際に仕事をするのが、これから説明するサブプログラムです。

４－１．指定範囲に含まれる図形を取得し、削除するマクロ

図形を削除する前に、削除する図形を捜す必要があります。そのための「指定範囲に含まれる図形を取得」する関数が図４－１です。
  1. '============　⇩④　指定範囲に含まれる図形を取得する関数　 =============
  2. Function　Shape_Range(R)　As　Variant()　　 '←範囲Rに完全に入っている図形を返す関数
  3. 　Dim　S_Array()　As　Variant　　　　　　　 '←図形(=図形を示す文字列)を入れる配列を宣言
  4. 　Dim　i　As　Long　　　　　　　　　　　　　 '←ｶｳﾝﾀｰ用変数(=図形の数を表している)
  6. 　i　=　0　　　　　　　　　　　　　　　　　 '←図形数の初期値はゼロ
  7. 　For　Each　c　In　R .Parent.Shapes　　　　 '←範囲Rのあるｼｰﾄ内の図形を全て調べる
  8. 　　If　Not　Intersect(c.TopLeftCell,　R)　Is　Nothing　_
  9. 　　　And　Not　Intersect(c.BottomRightCell,　R)　Is　Nothing　Then　 '←範囲R内に図形の左上･右下が入っている
  10. 　　　　i　=　i　+　1　　　　　　　　　　　　 '←図形数の値を1つ増やして
  11. 　　　　ReDim　Preserve　S_Array(1　To　i)　 '←図形を入れる配列を1つ増やして
  12. 　　　　S_Array(i)　=　c.Name　　　　　　　 '←図形の名前を配列に格納する
  13. 　　End　If
  14. 　Next　c
  15. 　Shape_Range　=　S_Array　　　　　　　　　 '←範囲R内に入っている図形の名前を入れた配列を返り値として返す
  16. End　Function
図４－１

この関数「Shape_Range」は引数として「シート名も含めたセル範囲」を受け取ります。引数R は、図４－９の８７行目から渡され、またその８７行目は図３－３の４１行目・４８行目から渡されてきます。
関数の返り値としては「図形を表す文字列の配列」になるので、タイプはString型とも考えましたが、この返り値を受け取る図４－９の８７行目の「（Worksheet).Shapes.Range(返り値)」を調べてみるとVariant型で受けていましたので、図４－１のShape_Range関数もVariant型としました。（もう少し調べる必要はあるかもしれません）

７０行目の変数 S_Array は、このプロシージャ内で使用する配列です。この配列の中に図形を表す文字列を代入し、最後にまとめてこの関数の返り値に渡します。

７４行目で対象シート内の図形を全て取り出して順次調べていきます。調べる要素であるShapesコレクションは、WorksheetオブジェクトのShapesプロパティで求めますが、引数として渡されているのはセル範囲だけですので、Worksheetオブジェクトは「R . Parent」（セル範囲の親 ＝ ワークシート）で求めています。
そして調べる図形が指定範囲に入っているか否かは、７５～７６行目で調べていますが、今回はIntersectメソッドを使用しています。Intersectは、第１引数と第２引数に渡した各セル範囲の重なっているセル範囲を返してくるものです。
７５～７６行目のIF文を図４－２の例を使って見てみましょう。プロシージャとして渡された引数Rを黄色範囲（D3：F9）とし、シート上にはイロハニホの５つの図形が存在するとします。それぞれの図形に赤丸（左上）・黒丸（右下）をつけてありますが、その印が乗っているセルが「c.TopLeftCell」（赤丸）、「c.BottomRightCell」（黒丸）になります。

図４－２

まず７５行目（IF文の前半部分）は、図形の左上セル（赤丸）と渡された指定範囲（黄色範囲）との関係を、そして７６行目（IF文の後半部分）は、図形の右下セル（黒丸）と渡された指定範囲（黄色範囲）との関係を調べています。重なっている場合はそのセル範囲を返してきますし、重なっていない場合はNothngを返します。For Each Next を使ってそれぞれの図形について調べた結果は図４－３の様になります。
図形　Intersect (c. TopLeftCell, 　R)　　Intersect (c. BottomRightCell, 　R)　
イNothingRange("D5")
ロRange("F9")Nothing
ハRange("E5")Range("F7")
ニNothingNothing
ホNothingNothing
図４－３

IF文の中で、Intersectの返り値を「Is Nothing」で調べています。これはIntersectの返り値がRangeオブジェクトであるためで、セルが空か否かを調べるような「IF 〇〇 = "" Then ・・」みたいな比較演算はできません。
Intersectの返り値がNothing の時だけ、イコールが成立しTrue が返されます。（図４－４）
図形　Intersect (c.TopLeftCell,　R)　 Is　Nothing　　Intersect (c. BottomRightCell,　R)　 Is　Nothing　
イTrueFalse
ロFalseTrue
ハFalseFalse
ニTrueTrue
ホTrueTrue
図４－４

そのTrue、False に対して先頭に「Not」をつけると、True　と　False　が反転します。（図４－５）
図形　Not Intersect (c. TopLeftCell,　R)　 Is　Nothing　　Not Intersect (c. BottomRightCell,　R)　 Is　Nothing　
イFalseTrue
ロTrueFalse
ハTrueTrue
ニFalseFalse
ホFalseFalse
図４－５

７５行目と７６行目は「AND」でつながっていますので、両方ともTrueの時のみTrueになります。（図４－６）
図形　Not Intersect (c.TopLeftCell,　R)　 Is　Nothing　AND　Not Intersect (c.BottomRightCell,　R)　 Is　Nothing　
イFalse
ロFalse
ハTrue
ニFalse
ホFalse
図４－６

ということで、黄色範囲に完全に含まれているのは「図形ハ」のみ、という判断ができるのです。
このようなロジックで指定範囲に含まれている図形が存在する場合は、図４－１の７７行目に進みます。
７７行目でカウンター変数に１を足し、７８行目で配列のサイズを１つ大きくします。この時に１つ前までの配列の値を保持するようにPreserveオプションを付けます。
７９行目で、サイズを広げた配列の最後に「指定範囲に含まれている図形の名前」を代入します。
全ての図形に対して同様の処理をした後、８２行目でその配列をShape_Rangeの返り値にする処理をします。

ちなみに、図４－６の「AND」を「OR」に変えると「どちらかがTrueならばTrue」になり「範囲に少しでもかかっている図形も取得」できそうですが、そうはいきません。
図４－６の図形「ホ」をみて下さい。実際には黄色のセルに跨っているのに、結果はFalse（＝重なっていない）と計算されてしまいます。図形の左下は重なっているのですが、計算式では左上と右下しか判断の材料に入れていない為です。

ではどうするか。「図形の左上・右下のセル」ではなく、図４－７のように「図形を全て含む範囲」と黄色範囲を比べれば良いのです。

図４－７

図形を全て含むのですから、通常の範囲指定と同じようにRangeの引数に左上セルと右下セルを指示して「 Range(c.TopLeftCell, c.BottomRightCell) 」とすれば図形を含むセル範囲が取得できます。
あとは、図４－３以降と同様に、「 Is Nothing　」と「　Not　」で判断式を作っていきます。
図形　Intersect(Range(c.TopLeftCell, c.BottomRightCell),　R)　
イRange("D3:D6")
ロRange("F9")
ハRange("E5:F7")
ニNothing
ホRange("F3")
　　　　　　　　　　
図形　Intersect(Range(c.TopLeftCell, c.BottomRightCell),　R)　 Is Nothing　
イFalse
ロFalse
ハFalse
ニTrue
ホFalse
　　　　　　　　　　
図形　Not　Intersect(Range(c.TopLeftCell, c.BottomRightCell),　R)　 Is Nothing　
イTrue
ロTrue
ハTrue
ニFalse
ホTrue
図４－８

ということで、一部でも重なる図形の判断式　＝　Not Intersect(Range(c.TopLeftCell, c.BottomRightCell), R) Is Nothing
となります。


次に、図４－１の関数を使用して、実際に図形を削除するのが以下のプロシージャです。尚このプロシージャは、図３－３の４１行目と４８行目から呼び出されるものです
  1. '============　⇩⑤　指定範囲の図形を削除するプロシージャ　 ========================
  2. Sub Shape_Cut(R As Range)
  3. 　On Error Resume Next　　　　　　 '←範囲R内に図形が無い場合はｽﾙｰする
  4. 　　R.Parent.Shapes.Range(Shape_Range(R)).Delete　 '←範囲R内にある図形を削除
  5. 　On Error GoTo 0
  6. End Sub
図４－９

８７行目の.Range()のカッコ内で図４－１の関数を使用していますので、引数Rの範囲に含まれている図形の名前の配列が.Range()のカッコ内に返ってきます。.Range()のカッコ内に決まった図形の名前を入れる場合は「.Shapes.Range(Array("A","B","C")」の様に書きますが、Arrayといえば配列ですね。つまり、.Range()のカッコ内にいれるのは配列なので、図４－１の Shape_Range関数の返り値は配列にしたのです。
８７行目の一番右側には .Delete メソッドがついていますので、選択された図形を削除することができます。

しかし、Shape_Range(R)関数で範囲R内に１つも図形が存在しない場合もあります。その時Shape_Range(R)は配列要素の無い状態ですので、８７行目は図形を確定できずエラーが発生します。
ですので、その直前の８６行目の「On Error Resume Next」で、８７行目でもしエラーが出ても次に進む　ようにさせています。削除する図形がないだけですので特にエラーコードを出す必要も無く、エラーを無視したら８８行目で元に戻します。

４－２．指定範囲の外枠に跨っている図形を取得し、注意喚起するマクロ

４－１（指定範囲に含まれる図形を取得）と同様の流れで、まず「指定範囲の外枠に跨っている図形を取得」する関数です。
  1. '============　⇩⑥　指定範囲の枠を跨っている図形を取得する関数　 ========================
  2. Function Shape_Range_XOR(R) As Variant()　　 '←範囲Rの境界線を跨いでいる図形を返す関数
  3. 　Dim S_Array() As Variant　　　　 '←図形(=図形を示す文字列)を入れる配列を宣言
  4. 　Dim i As Long　　　　 '←ｶｳﾝﾀｰ用変数(=図形の数を表している)
  6. 　i = 0　　　　　　　　 '←図形数の初期値はゼロ
  7. 　For Each c In R.Parent.Shapes　　　　　　 '←範囲Rのあるｼｰﾄ内の図形を全て調べる
  8. 　　If (Not Intersect(Range(c.TopLeftCell, c.BottomRightCell), R) Is Nothing)　Xor　_
  9. 　　　(Not Intersect(c.TopLeftCell, R) Is Nothing _
  10. 　　　And Not Intersect(c.BottomRightCell, R) Is Nothing) Then　 '←範囲Rに図形が跨っている場合は
  11. 　　　　i = i + 1　　　　　　 '←図形数の値を1つ増やして
  12. 　　　　ReDim Preserve S_Array(1 To i)　　　　 '←図形を入れる配列を1つ増やして
  13. 　　　　S_Array(i) = c.Name　　　　　　 '←図形の名前を配列に格納する
  14. 　　End If
  15. 　Next c
  16. 　Shape_Range_XOR = S_Array　　　 '←範囲Rの境界線に跨っている図形の名前を入れた配列を返り値として返す
  17. End Function
図４－１０

図４－１０は、図４－１のShape_Range(R)関数とほぼ一緒です。異なっているのは９７～９９行目のIF文で、その内９８～９９行目は図４－１と全く同じですので、IF文の後半は「範囲R内に完全に含まれている図形」を意味します。

図４－７のところで説明した通り、
1)完全に重なる図形　　＝　Not Intersect(c.TopLeftCell,　R)　Is　Nothing　AND　Not Intersect(c.BottomRightCell,　R)　Is　Nothing
2)一部でも重なる図形　＝　Not Intersect(Range(c.TopLeftCell, c.BottomRightCell), R) Is Nothing
となります。

1)と2)の関係は、　「2)一部でも重なる図形」＝「1)完全に重なる図形」＋「3)一部でしか重ならない図形」　です。
なので、「指定範囲の外枠に跨っている図形」を得るには、「2)一部でも重なる図形」から「1)完全に重なる図形」を取り除けば良いわけです。
と言って、単純に引き算をする訳にもいきません。１つの方法としては、IF文で「2)一部でも重なる図形」を拾い上げ、次に「1)完全に重なる図形」では無い図形を拾い上げる　というやり方もあります。
もう一つの方法は、「排他的論理和（XOR）」という方法です。これは、両方が同じ（両方True または 両方False）であればFalse、異なれ（一方がTrue、一方がFalse）ばTrueと計算します。図で書くとすると図４－１１の右側のように、境界に跨る図形のみを抽出することが出来ます。

図４－１１

式としては、上の黄色く塗った「1)完全に重なる図形式」と「2)一部でも重なる図形式」を「XOR」で結びます。
図形　1)完全に重なる図形式　　2)一部でも重なる図形式　
イFalseTrue
ロFalseTrue
ハTrueTrue
ニFalseFalse
ホFalseTrue
　　　　　　　　　　
図形　1)完全に重なる図形式　XOR　2)一部でも重なる図形式　
イTrue
ロTrue
ハFalse
ニFalse
ホTrue
図４－１２

ということで、図４－１０の９７～９９行目のIF文が完成します。
他の流れは、図４－１と全く同じです。

次に、図４－１０の「指定範囲の外枠に跨っている図形」のデータを使って、図４－１３の通り処置をします。
この関数は、図３－３の１８行目から呼び出されます。
  1. '============　⇩⑥　指定範囲の枠に図形が跨っている時の処置プロシージャ　 =======================
  2. Function Shape_Group_XOR(R)
  3. 　On Error Resume Next　　　　 '←枠に跨る図形が無い場合にはｴﾗｰが発生する
  4. 　　R.Parent.Shapes.Range(Shape_Range_XOR(R)) .Select　　　 '←範囲Rの枠に跨っている図形を選択
  5. 　　If Err = 0 Then　　　　　　 '←範囲Rの枠に図形が跨っている場合
  6. 　　　MsgBox "記入枠と重なっている図形があります" & vbCrLf & "枠に掛からない様に調整して下さい"　　 '←忠告
  7. 　　End If
  8. 　　Shape_Group_XOR = Err　　 '←跨っている場合は週の移動をｽﾄｯﾌﾟさせるフラグを立てる
  9. 　On Error GoTo 0
  10. End Function
図４－１３

１１０行目で、図４－１０の関数を使用して範囲Rの外枠に跨っている図形を取得し、その図形を選択（Select）しています。選択するのは、どれが跨っている図形なのかをユーザに知らせるためです。
しかし、外枠に跨っている図形が無い場合もありますので、このままですと「選択する図形が無いのに選択しようとするとエラー」が発生します。それを回避するために直前の１０９行目で「On Error Resume Next」を入れ、エラーが発生しても次に進む様にしています。
エラーが無い時はErr番号はゼロ、エラーが発生するとゼロ以外のErr番号が発生しますので、そのErr番号を元に警告などの処置をするのが普通ですが、ここでは「範囲Rの外枠に跨った図形があり、選択できた」ことでErrが発生しなかったことを利用（１１１行目）して、１１２行目で警告を出しています。
そして、Err番号をこの関数の返り値にして（１１４行目）、プロシージャを抜けます。
なお、１１５行目の「On Error GoTo 0」の位置ですが、本関数プロシージャの一番最後に置いています。これは「On Error GoTo 0」を通過するとErr番号が消えてゼロに戻ってしまうため、１１４行目で関数の戻り値を設定したあとでErr番号をリセットさせています。

なお、この関数を受け取るコード（図３－３の１８行目）を再掲します。
「　If　Shape_Group_XOR(Memo_Range)　=　0　Then　GoTo　Value0　」
「関数の返り値＝ 0 」としていますので、この関数がゼロ（範囲Rの外枠に跨る図形があった）だったら、画面のコピペなどの処置工程は飛ばし、行ラベル Value0 以降の「スクロールバーを中立に戻す」作業をするのです。

４－３．指定範囲をコピペするマクロ

図３－３の４５、５２行目で実施されるコピペの部分のプロシージャです。
  1. '============　⇩⑦　指定範囲から指定範囲へコピペするプロシージャ　 =======================
  2. Sub Copy_Paste(R1, R2)
  3. 　Dim CopyObjectsNG As Boolean
  4. 　If Application.CopyObjectsWithCells = False Then
  5. 　　CopyObjectsNG = True
  6. 　　Application.CopyObjectsWithCells = True　　　 '←セルをコピーした時に図形も一緒にコピーされるモードにする
  7. 　End If
  9. 　R1.Copy R2　　　　　　　　　　 '←R1の範囲をコピーし、R2に貼りつける
  11. 　If CopyObjectsNG = True Then
  12. 　　Application.CopyObjectsWithCells = False
  13. 　End If
  14. End Sub
図４－１４

１２５行目の「R1.Copy R2」がこのプロシージャの本体です。プロシージャの第一引数R1の範囲をコピーし、第二引数R2の範囲へペーストしています。
Copyメソッドに引数を与えずにCopyメソッドを実行し、その後Pasteメソッドを使用する（人手で行うコピペと同じ）と、コピーした段階でデータがクリップボードに一旦保存され、ペーストで貼り付く事になります。ですのでPaste後もデータが残っている間は再びPasteできます。
しかし、１２５行目のように Copyメソッドに引数を与えて使用すると、データはクリップボードを経由しないために、その後 Paste をしても貼り付けられるものがなく、エラーが発生しますので注意が必要です。

また、今回のスケジュール帳アプリでは、セル内容・セル書式と一緒に「図形も一緒にコピペ」されないと存在意義が薄くなります。標準でExcelを使っていれば図も一緒にコピペされるのですが、Excelの設定で切り替えられるようになっています。
Excelのファイルタブ→オプション→詳細設定　を選び、「切り取り、コピー、貼り付け」の項目の「挿入したオブジェクトをセルとともに切り取り、コピー、並べ替えを行う」にレ点が付いているか確認してみて下さい。（図４－１５）

図４－１５

このオプションをOFF（＝レ点を外している）にしていると、図が一緒に行かなくなってしまうので、図４－１４の１１９～１２３行目でマクロ側でONにする処置をしています。
まず、開いているExcelの「(略)セルと共にコピーオプション」の設定がどうなっているかを１２０行目で確認しています。確認方法は「Application.CopyObjectsWithCells」プロパティを調べ、TrueであればON、FalseであればOFF と分かります。
OFFであれば、１２２行目の様に「Application.CopyObjectsWithCells = True」を設定することでONになりますが、ユーザが「自覚してOFFにしている」場合もあります。勝手に個人の設定を変更してしまうのもマズイですし、他のアプリで不具合が出てくる可能性もあります。
ですので、このスケジュール帳を「使用する間だけONにして、終わる時には元の状態に戻す」ことを考えました。それが１１９行目で宣言しているCopyObjectsNG変数です。ExcelがOFF設定の時は１２１行目で変数にTrueのフラグを立て、コピー動作が終了したら１２８行目で元に戻す作業をしています。

４－４．指定範囲の列幅を広げるマクロ

図３－３の４３行目から呼び出されているプロシージャです。第一引数R1・第二引数R2は両方ともセル範囲(Range型)で、R2のセル幅をR1のセル幅と同等以上（もともと幅が広い場合もある為）にするものです。
セル幅にこだわる理由は、Sheet1のスケジュール記入側で図形を右枠線近くに配置した際、記入側のセル幅の方が保存側（Sheet2）より広い場合には、保存側では図形がセル幅の右端に貼り付く形になります。右端に貼り付いていても図形は拾えるはずなのですが、試行してみると時々拾いのがして、図形がどんどん重なっていく現象が見られました。
微妙な図形位置がエラーを引き起こしているようなので、保存側のセル幅を記入側以上にする事で、エラー発生を抑えることにしました。ちょっと現場的な手法ですがお許し下さい。
  1. '============　⇩⑧　指定範囲の列幅を広げるプロシージャ　 =======================
  2. Sub Cell_Width(R1, R2)　　　 '←保存先の列幅を記入幅よりも広くするﾌﾟﾛｼｰｼﾞｬ
  3. 　If R1.ColumnWidth > R2.ColumnWidth Then　　　 '←記入部より保存部の幅が狭かったら
  4. 　　R2.ColumnWidth = R1.ColumnWidth　　 '←記入部と同等のセル幅に設定する
  5. 　End If
  6. End Sub
図４－１６

流れはいたって簡単で、１３３行目でセル幅のサイズを比較し、R2の方が狭かった場合は１３４行目でR1同等にしています。
尚、このプロシージャは一般的には使えません。まずは引数のR1とR2の列数が単列（１列）の時しか考慮されていません。R1に複数列の範囲を指定した場合には、最左列の列幅しか評価せず、変更する側のR2の幅は複数列を指定したとしても全てR1範囲の最左列と同じ列幅になります。
もし、記入側の画面で複数列で使用したい方は、１列ずつCell_Widthプロシージャを流してください。但し、記入済みの図形の配置がズレる可能性もありますのでご注意をお願いします。

４－５．指定範囲に罫線を引くマクロ

スケジュール帳の記入欄は、３行／日 x ７日 にしていますが、日にち毎に罫線を引いておかないと使い辛そうと思われます（個人的な意見ですが）。ですので、保存シート側から「新品画面」を持ってくる際に日毎に罫線を入れるプロシージャを作成しました。
  1. '============　⇩⑨　日毎の罫線を引くプロシージャ　 =======================
  2. Sub Line_Draw(R)　　　　　　　　　　　　　　　 '←新しく表示した週が初表示の時に日毎の線を入れるﾌﾟﾛｼｰｼﾞｬ
  3. 　If R(1).Offset(0, 1) <> "" Then Exit Sub　 '←右肩に日付が記入(ﾕｰｻﾞが罫線を変更している可能性有り)されていたら
  5. 　For i = 1 To 6
  6. 　　With R(i * 3 + 1).Borders(xlEdgeTop)　 '←3行ずつ罫線を記入
  7. 　　　.LineStyle = xlContinuous　　　　　　 '←実線
  8. 　　　.Weight = xlHairline　　　　　　　　 '←極細線
  9. 　　End With
  10. 　Next i
  11. End Sub
図４－１７

まず、保存側（Sheet2）のデータの右肩部に週の日付が記入されます（図３－３の４６行目）。この記入のタイミングは、記入側にある記入済みデータを保存側にコピぺした直後です。つまり「保存側データに日付が入っている　＝　記入済み」を意味しています。
記入済みと言うことは罫線も自分で加工した可能性がありますので、プログラム側で勝手に罫線を修正するのはよくありません。よって日付の入ったデータの場合には罫線を引かないままプロシージャを抜ける（１３９行目）ようにしています。

日付の入っていない（＝初めて記入側に表示した）データの場合は、罫線を引いていきます。
１４１～１４６行目の通り、３行／日ですので３行飛びにセルの罫線を変更します。７日／週なのに６回しかForを回していないのは、記入シート側にの太枠線があるので、日と日の間（７－１＝６）を引いています。
罫線には色々な種類がありますので、必要でしたら変更してください。


５．残された課題

今回のスケジュール帳には、いくつか課題が残されていると思っています。

５－１．２週に渡って表示できない

今回スケジュール帳を作るに当たり、２週分を「１・２週」、「２・３週」、「３・４週」みたいに並べて表示して、週を跨いだ矢印など（例えば、日程を延期した等）を記入したいと思いました。しかし保存するデータの単位は１週間にする必要があるので、週に跨った図形は週の境目で分割しなくてはいけません。
調べた結果、図形の分割機能はPower_Point にはあるのですが、Excelでは無理のようでした。これが可能になれば、１UPできるのに残念です。

５－２．データが溜まっていくとファイルサイズが大きくなる

２０年前にも発生した問題ですが、データが溜まっていくとファイルサイズが大きくなってしまうことです。特に図形を一緒に保存しているため尚更厳しくなります。
Worksheet当たりに保存できる週の数を限定し、新しいデータは新しいシートに保存し、古くなったデータはシート毎削除する（又は移動する）ような機能や、古いデータを消して行削除しStart_Day を持ち上げるような機能などを盛り込む必要がありそうです。

５－３．図形のグループ化

長期間使用し保存シートの図形データが増えてきた時、指定範囲内の図形を捜す機能を Shape_Range(R) 関数で実現させていますが、そのプロシージャの中では「For　Each　c　In　R .Parent.Shapes」と、データシート全体の図形を１つずつ調べている事になります。つまり図形の数が多いほど時間が掛かることになります。
そこで、保存シート内では「週毎に図形をグループ化」しようと考えました。以下がそのプロシージャです。
  1. '============　⇩ 図形をグループ化するプロシージャ　 =======================
  2. Sub Shape_Group(R)
  3. 　On Error Resume Next　　　 '←範囲R内に図形が無い、又は1個の場合はｽﾙｰする
  4. 　　R.Parent.Shapes.Range(Shape_Range(R)).Group　 '←範囲R内にある図形をグループ化
  5. 　On Error GoTo 0
  6. End Sub
  7. '============　⇩　図形のグループ化を解除するプロシージャ　 =======================
  8. Sub Shape_UnGroup(R As Range)
  9. 　On Error Resume Next　　　　　 '←範囲R内に図形が無い、又は1個の場合はｽﾙｰする
  10. 　　R.Parent.Shapes.Range(Shape_Range(R)).Ungroup　 '←範囲R内にある図形をグループ化
  11. 　On Error GoTo 0
  12. End Sub
  13. '============　⇩　メインプログラムの中で呼び出すコード　 =======================
  14. 　　Call Shape_Group(Memo_Range)　　　　　 '←記入側から保存側にコピペする直前に実行
  15. 　　Call Shape_UnGroup(Memo_Range)　　　　 '←保存側から記入側にコピペした直後に実行
図５－１

しかし試行してみた結果、図形をGroup化すると元の図形の範囲より一回り大きくなってしまい、保存側の範囲よりもオーバーしてしまう可能性に気が付きました。すると、コピー・ペースト前に削除できない図形が出てきて、表示画面で図形が重なる不具合も確認できました。（枠の内側に完全に入っている図形しか削除していないため）
これの解決策として、保存範囲の外枠に跨っている図形も削除する方法も考えられますが、前週・翌週のデータまで切ってしまう可能性も発生しますし、あらかじめ保存側の四方に余裕を持たせるか、記入側の四方に余裕を持たせる方法くらいしか、今のところ思いつきません。

５－４．コピペした時の図形位置とセル範囲の関係

今回は、セル範囲内に図形が完全に入っている状態で「表示画面」と「保存シート」との間で「セル範囲のコピー・ペースト」で行っています。で、なんとなくセル範囲から少しはみ出した図形でコピーしてみると、図形コピーが成功しました。
ではどの位置までコピー可能か試してみると、「図形の中心がセル範囲に入っているとコピーできる」ような感じでした。
色々なサイトを調べているのですが、どこにも載っていないので、ちょっと面白そうな課題です。

５－５．最初の表示週に日毎の罫線が引いていない

罫線を引くプロシージャは、保存側から表示側にデータを持ってくる時に動作します。つまり、新品状態の時には罫線が引いていないのです（引くタイミングが無い、と言った方が正確かもしれません）。申し訳ないのですが、必要な方は罫線を引いてから使って下さい。


６．最後に

時代遅れのスケジュール帳とは言え、とりあえず試行くらいは出来るように作ってみました。初めに書いたように、セルデータと同時に図形などのオブジェクトを扱うのは、結構手間です。今回検証しませんでしたが「図形の位置がズレてしまう」不具合も様々なサイトで扱っているようです。
Excelは表計算ソフトで、この様なメモ帳的な使い方は可能とは言え邪道とも言えますが、並べたデータだけを見ていても何も分からないことも事実です。データを可視化する為にも、グラフ・図形の様なオブジェクトが必要になるのも確かです。
表計算ソフトとしてのExcelを意識しながら、データを活かす事に注力すべきと思います。


図形も貼り付けられるスケジュール帳（it-017.xlsm　約42KB）

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