2021/03/28

マウス操作で日程の開始・完了を設定できるタスク表




1.背景

日程表には様々な様式がありますが、図1-1のようなガントチャートもその1つです。
ガントチャート
図1-1(図は、Wikipediaより引用し加工)

1つの仕事の中を細かい作業(タスク)に分けることが可能で、且つそのタスク同士に関係性がある(=タスクの前後関係や、その間隔に決まりがある)場合には、このような日程表でスケジュール管理や工程管理をすることは有効と思います。
ガントチャートの良いところは、作業計画・実績が視覚的に分かることと、タスクの関係性をデータが保持しているために「日程を修正する時に、前後のタスクも同時に修正する(又は、注意を促すコメントが出る)」ことだと思います。
基本は横棒グラフなので「Excelでもグラフ機能を使えば近いことはできる」とは思いますが、市販でもプロジェクト管理ソフトはたくさん出ていますので、本格的に行うには専用アプリの方が良いと思います。

私も少しだけ「Microsoft Project」や「SynViz S2」などを使って日程管理をしたことがありますが、「タスクの日程線をマウスで前後に移動させたり、伸縮させる」という操作はExcelには無い操作感覚であり、昔から「ぜひExcelで実現させたい」と思っていました。

このサイトの1課題としてもトライと断念を何回か繰り返しましたが、今回「ちょっと使えるかも」というようなものが出来ましたので紹介します。

2.システム概要

サンプルファイルは図2-1のように日程表っぽくしてありますが、工夫したところは「G列~T列で日程線を視覚に基づいて引く」ことにより「E列~F列の開始日・完了日になる」ところです。
変更したい日程をダブルクリック
図2-1

G列~T列には「青い日程線」が引かれていますが、これは「G4~T13セルに条件付き書式がセット」されており「E列~F列の日付と、G2~T2セルのカレンダー日付を比較」し、「開始日から完了日までのセルを青く」しているだけです。
G2~T2セルのカレンダーは「表示週切り替えスクロールバー」で1週ずつ移動するようにしています。

日程線の変更方法ですが、例えば5行目の「稟議作成」の日付を変更したい場合、5行目の青色のセル(=日程線)のどこかを「ダブルクリック」します。すると「青いセル範囲を囲むような図形枠(良く見ると、両方向矢印になっている)」が現れます。

その矢印図形を図2-2のように、変更したい日付のところまで「横方向に変形」させます。
なお矢印図形表示中は、図形がセルに吸着するように動く(グリッド合わせがONになる)ので、日付に合わ易くなっています。また、図2-2では「完了日を変更」させていますが、「開始日を変更」することも、期間は変えずに「全体を移動」することも可能です。

また、図形は上下方向への変形及び移動も可能ですが、矢印図形の動きについては常に監視をしており「上下方向の変形・移動をしても元に戻す」ようにしています。
変更日まで図形を移動
図2-2

新たな日程(開始日・完了日)に図形矢印の位置がなりましたら、図2-3のように「任意のセルを選択」します。すると日程が確定し、矢印図形は消えて開始日・完了日が書き換わります。(変更しなかった場合は、日付はそのままです。)
また「任意のセルを選択」せずに「表示週切替」のスクロールバーを操作しても、日程変更をしてから週の移動をします。
変更日を確定
図2-3

1つ1つのタスクの集合体は「プロジェクト」であり、その大日程の中に「過去のタスク」「現在進行中のタスク」「始まっていないタスク」などがあります。プロジェクト全体を見渡す係の人もいますが、作業をする人は「現在進行中のタスク」に注目し細かく見る必要があります。
ちょうど図2-4のように「全体の一部を窓から覗く」感じです。この窓枠が、今回サンプルファイルでは2週間の長さとし、スクロールバーを使えば左右に窓を移動できるようにしています。
ガントチャート全体の中での表示域
図2-4

窓の位置(見ている日程の範囲)によって、日程線の見える形は異なります。
例えば図2-5の5行目は、見えている範囲よりも前から始まっているタスクですし、8行目は完了日が見えている範囲よりも先のタスクです。このように見えている範囲外に開始日・完了日があるタスクの場合は、片方の端部が矢印型ではない矢印図形としています。
7行目のように開始日・完了日の両方が、表示範囲に入っている場合は両矢印型の矢印図形となります。

矢印図形の形の違い
図2-5

また図2-5の10行目のように、開始日・完了日の両方とも表示範囲内に入っていない場合には、今回のシステムでは操作できないこととしました。操作しようとダブルクリックしても、図2-6の10行目のように「メッセージが出て終了」します。
プロジェクト管理ソフトの中には、このようなタスクを操作しようとすると「両端の情報が確認できて操作可能」のようなものもありますが、今回は省略しました。

また、どの部分をダブルクリックするかで、図2-6のように動作が変わってきます。
青い日程線部分をダブルクリック①すれば、その日程線の形に合わせた図形枠が表示されますが、日程線以外の部分をダブルクリック②③すると、その選択したセルの日付の場所に矢印図形が現れます。②のように既に日程線が存在しても、その行の日程線以外でダブルクリックし日程を確定(どこかのセルを選択)すれば、そちらが「新たな日程」になります(既存の日程データが書き換えられる)ので注意が必要です。
なお、日程線の枠(今回で言えば、G4セル~T13セル)の外をダブルクリックしても、矢印図形は表示されず、通常のExcel操作(通常はセルの編集)となります。
ダブルクリック位置での動作の違い
図2-6

しかし「うっかり、違う場所をダブルクリックしてしまった」と言う場合もあるかと思います。
ダブルクリックしたのが既存の日程線上であれば、変形などをせず「どこかのセルを選択」すれば既存の開始日・完了日は変更されません。一方、日程線で無い部分をダブルクリックし、任意のセルを選択してしまうと、既存のデータが書き換わってしまいます。
このような場合は、G1セル辺りにある「矢印取消」ボタンをクリックしてキャンセルして下さい。
(書き換わった開始日・完了日データを元に戻すものではありません。)

なおプログラム的には、「ESCキー」「DELキー」でもキャンセルできるようにしていますが、少ない確率ですが失敗することもあるようなので「矢印取消」ボタンが確実だと思います。

3.プログラムの流れ

プログラムは「日程線領域(ArrowArea)」の中でダブルクリックをするところから始まります。
プログラムの流れ
図3-1

まずダブルクリックをしたセルが日程線上(=青色セル上)であるか否かで仕訳け、日程線以外の場合には「矢印図形の描画位置」は「ダブルクリックのセル」とします。また、矢印図形の形状は「両矢印」とします。
一方、ダブルクリックした位置が日程線上の場合は、開始日・完了日のデータから「青いセルの範囲」と、表示されている日付範囲の中に開始日・完了日が含まれているか否かで「矢印図形の形状(タイプ)」を決めます。

図形のタイプは、表示日付の範囲に開始日・完了日の両方が入っている場合は「⇔」、開始日が入っていない場合は「⇒」、完了日が入っていない場合は「⇐」という矢印形状にします。(矢印では無い『平らな側』は、動かす対象では無い という意味)

Shape_Formプロシージャで計算された「図形描画範囲」と「矢印図形のタイプ」を受け、Shape_MakeプロシージャではAddShapeメソッドを使い矢印図形を描画します。
続けて、描画した図形が変形されないかのチェック(Shape_Checkプロシージャ)を開始します。

ユーザーの図形操作により「図形が変形」された場合には、まずARcellFixプロシージャで「矢印図形がセル単位になる」ように図形の位置・寸法の微調整を行います。
今回のシステムでは、矢印図形は「図形のグリップ合わせ」機能を使って「セル単位」になるようにしているのですが、微妙なズレがあったり、また日付の列幅が揃っていない為に図形を移動した時にセル単位にならない、という場合が発生します。
まずはその「ズレ」を修正してから、「矢印図形が日程線領域をオーバーしているか等」の判断・処理をARareaFixプロシージャで行います。

ARareaFixプロシージャでは、主に「矢印図形が日程線領域をオーバーしていないか」をチェックし、オーバーしている時には「元に戻す」または「日程線領域内に入るように縮める」という処理をします。
またユーザーの図形操作によっては図形が左右が反転してしまう場合もあるため、その場合には反転を元に戻します。

ユーザーによる矢印図形での日程調整が完了し「任意セルをクリック」すると、「SelectionChangeイベント」が発生し、Data_Fixプロシージャが呼び出されます。
矢印図形の左端・右端に属するセル位置から、開始日・完了日の日付を計算します。片矢印の場合「端部が平な形状側」は「動かす対象では無い」ので、矢印側の日付だけを修正します。

日付修正をしたら、矢印図形を削除し、プルグラムを終了します。

4.ワークシート上の数式・条件付き書式の設定など(Sheet1)

4-1.表示日付セルの数式

図4-1のように、G2セル~T2セルの2週間分の日付セルには数式が入っています。
まず「基準となる日付」がD2セルに入っており、サンプルファイルでは2021年3月7日になっています。
また、E2セルには「基準日に加える週の数」が入っています。このE2セルの値は、すぐ隣のスクロールバーで書き換えます。
表示日付の数式
図4-1

そのD2セル、E2セルの値を使って、「日付セルの最左端(G2セル)」の数式を組み立てています。式は図4-1の数式バーにも表示されていますが「=D2 + E2*7」としています。つまり「基準日D2から、E2週間あとの日付」となります。
その先のH2セル~T2セルには「左隣に1を足す」という式が入っていますので、2週間分の日付が並ぶことになります。
またG3セル~T3セルに曜日を手入力で書き込んでいますが、日曜から始めていますので、D2セルの基準日も「日曜日」の日付にする必要があります。

なお、日曜日と土曜日の列の背景色は、手入力で設定しています。
また、D2セル、E2セルは「サンプルファイルでは見えてしまっています」が、本来はユーザーには隠すところです。別なところに設定するとか、スクロールバーの下にするとか、文字色を白にするなどの工夫をして下さい。

4-2.スクロールバーの設定

ワークシート上に配置できるスクロールバーには「フォームコントロール」と「ActiveXコントロール」の2種があります。
私も今回システムの作り初めは「フォームコントロール」で作り、その「リンクするセル」にE2セルを割り当てていました。

しかし日程線の矢印図形で日程を定めた後、どのセルも選択せずに「矢印図形がSelectされた状態から、直接『週を変更する』操作もある」ことに気が付きました。
Excelには「図形が選択状態で無くなる時に発生する『LostFocusイベント』のようなもの」はありませんし、スクロールバーによる「週変更」が実行された後で矢印図形の位置を計算してもダメです。

仕方なくスクロールバーは「ActiveXコントロール」にし、マクロで「矢印図形から開始日・完了日の書き出し(任意セルを選択した時と同等の作業)」を行ったあとに「E2セルへの値の書込み」を行うように変更しました。

なお作ったばかりのスクロールバーでは、Max値=32767(Integer型の正数の上限値)、Min値=0です。しかしスクロールバーのChangeイベントは「値が変更されないとイベントは発生しない」ので、例えば「スクロールバーの値がMax値、又はMin値」の場合は、それ以上動かそうとしても「値が変わらない」ことになり、つまりは「Changeイベントが発生しない」ことになってしまいます。
スクロールバーの設定
図4-2

ですので「クリックしても値が変わらない状態にしない」ことが必要なので、図4-2のように「Max値とMin値を大きな値に設定」する必要があります。今回システムの場合、スクロールバーのValue値は「週」を表しますので、100であれば約2年間となります。
プロジェクトの大きさによりMax値とMin値を決めてください。(図4-2では、±100に設定してあるので約4年間です)

寄り道
なお、スクロールバーがMax値・Min値に達した時には、図4-3のように「スクロールボックスが片方に寄っている」ことになります。
その状態から「スクロール矢印(両側の矢印のあるボタン)」をクリックしても「Changeイベントは発生しない」のですが、「スクロールボックスをクリックする」と「Changeイベントが発生する」のです。

スクロールバーの部位名
図4-3

何故、スクロールバーのValue値が変わらないのにChangeイベントが発生してしまうのか分かりません。
しかし、今回システムでは「この現象」が役に立ち、スクロールバーがMax値・Min値に達していなくても「スクロールボックスを(動かさずに)チョコンと触る」だけでChangeイベントが発生してくれて、矢印図形の後処理をしてくれるのです。
つまり、本来は矢印図形を確定するために「矢印図形から、任意のセルにSelectionを移動」する動作の代わりとして、「矢印図形から、スクロールバーにSelectionを移動」が成立するのです。

4-3.条件付き書式の設定

日程線を表示している領域には、条件付き書式が設定されています。
まず、その領域(サンプルファイルでは、G4~T13セル)に「名前」をつけます。領域をセル範囲選択し、右上の名前ボックスに「ArrowArea」と入力します。この名前は条件付き書式では使用しませんが、マクロ内(図5-1の4行目)で使用しますので必須作業です。
領域に名前を付けておけば、行挿入などで領域を広げても「広がった領域を名前が指す」ことになります。今回システムのように、領域が下に広げられる可能性のあるものには適していると思います。
エリアへの名前付けと条件付き書式の起動
図4-4(図は、既に条件付き書式が設定してある状態を示しています)

次に、リボンの「ホーム」タブ→「スタイル」グループ→「条件付き書式」から「新しいルール」を選択します(図4-4)。
表示された「新しい書式ルール」ダイアログ(図4-5)の「数式を使用して、書式設定するセルを決定」を選択し、数式欄に「=AND(G$2>=$E4,G$2<=$F4)」と入力します。

この数式は、選択したセル範囲(今回は、G4~T13セル)の左上角のセルの式として入力し、他の範囲内には「その数式を相対的にコピー」することになります。これは手動で「G4セルに数式を入力」し、そのセルを「コピー」した後に貼付け範囲を選択し「貼り付け」をするのと同じことになります。
数式入力と書式(塗りつぶし色)の設定
図4-5

左上角のセルの式として「=AND(G$2>=$E4,G$2<=$F4)」を見てみます。この式は「G$2>=$E4」と「G$2<=$F4」とを「AND」で結んでいます。
「G$2>=$E4」は「G4セルの日付(G2セル)が開始日(E4セル)以上」という意味になります。また「G$2<=$F4」は「G4セルの日付(G2セル)が完了日(F4セル)以下」となります。つまり「開始日と完了日とに挟まれている日付」の時に数式が成立します。
そして成立した時(条件に合致した時)だけ、セルの書式が「ダイアログの一番下で設定した書式」に変わります。

なおサンプルファイルでは、日曜日の列は薄い赤色、土曜日の列は薄い青色に手動で設定していますが、条件付き書式で数式が成立した時には「セルの元の書式の上に、条件付き書式の書式が上書きされる」ので、「薄い赤色が消えて、日程線の青色で線が引かれる」ことになります。
(E列・F列も手動で黄色の背景色にしています)

なお条件付き書式を後から調べたり、内容を修正するには、図4-6のように「ルールの管理」から行います。
条件付き書式のルールの管理
図4-6

4-4.「矢印取消」ボタンの設定

「ダブルクリックする行を間違えた」や「日程線(青色セル)以外のセルをダブルクリックしてしまった」などの時には、「矢印図形をキャンセル」する必要があります。その際には上部の「矢印取消」ボタンをクリックするのですが、クリックすることで起動するマクロを登録しておく必要があります。
図4-7のように、「ESCstop」プロシージャ(図6-28)を設定します。
「矢印取消」ボタンへのマクロ設定
図4-7

5.シートモジュール(Sheet1)

5-1.ダブルクリック時の処理

セルをダブルクリックした時は、図5-1の「BeforeDoubleClick」イベントが発生します。第一引数として「ダブルクリックしたセル位置」の「Target」と、第二引数の「Cancel」を受け取ります。
  1. '========== ⇩(1) ダブルクリック時の処理 ============
  2. Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean)
  3.  If Not Intersect(Range("ArrowArea"), target) Is Nothing Then
  4.   Cancel = True
  5.   Call Shape_Form(target)
  6.  End If
  7. End Sub
図5-1

4行目では、「ダブルクリックしたセル位置(Target)」が「日程矢印線の領域(ArrowArea)」の中か否かをしらべています。「ArrowArea」は図4-4で選択した範囲であり、且つ「条件付き書式」の適用先です。

領域内でダブルクリックされた場合は、5行目の「Cancel = True」で「セルのダブルクリックによる編集モード」をキャンセルします。そして6行目で「Shape_Form」プロシージャ(図6-3)を呼び出します。呼び出す時に渡す引数は、ダブルクリックをしたセル位置(Target)です。

5-2.セルを選択した時の処理

ユーザーが矢印図形でタスク日程を修正した後、確定させるために「任意のセルを選択」した時に実行されるのが、図5-2です。
受け取る引数Targetは「選択したセル位置」ですが、そのセル位置データは今回使用しません。
  1. '========== ⇩(2) セルを選択した時の処理 ============
  2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  3.  If Not AR Is Nothing Then
  4.   Call Date_Fix
  5.  End If
  6. End Sub
図5-2

「矢印図形で日程を調整している間は、矢印図形は存在」し、「日程を確定したら矢印図形は削除」されるため、14行目の「Not AR Is Nothing」で「矢印図形で日程を調整している間」のみ、15行目でDate_Fixプロシージャ(図6-27)を呼び出します。そのDate_Fixプロシージャでは「開始日・完了日の日付を書換」をしたのち「矢印図形の削除」をします。
矢印図形が存在しない場合(=日程修正中以外)は、通常のセル選択となります。

5-3.スクロールバー操作時の処理

週の切り替え用スクロールバーを操作した時は、図5-3のChangeイベントが発生します。Changeイベントは「スクロールバーのValue値が変更された時に発生する」と様々なサイトで説明されていますが、今回調べたところ「スクロールボックス(図4-3参照)」を動かさずにクリックするだけでもChangeイベントが発生しますので、注意が必要です。

今回システムでは、ユーザーが「日程を確認するために」週を切り替える時と、「あるタスクの修正日程が決まり、続けて次のタスクの日程修正をしようと」週を切り替える時の両方でスクロールバーが使われると考えました。
  1. '========== ⇩(3) スクロールバー操作時の処理 ============
  2. Private Sub ScrollBar1_Change()
  3.  Call Worksheet_SelectionChange(Range("a1"))
  4.  Range(PlusWeek) = ScrollBar1.Value
  5. End Sub
図5-3

23行目では、図5-2の「SelectionChange」イベントプロシージャを呼び出します。SelectionChangeには引数としてRange型のセル範囲を渡す必要がありますが、今回システムでは「どのセルを選択したか」は関係ありませんので、適当な「A1セル」としています。
また、25行目では「基準日に加える週の数」セルに、スクロールバーのValue値を入力しています。

上記で説明した「日程を確認するために」の場合と「続けて次のタスクの日程修正をしようと」の場合の両方とも、23行目・25行目の2つが実行されます。「続けて次のタスクの日程修正をしようと」の場合には2つとも必要になりますが、「日程を確認するために」の場合は必要なのは25行目のみです。
しかし「日程を確認するために」の場合には「矢印図形は存在していない」状態ですので、図5-2の14行目のIf文により「Data_Fix」は実行されずに終了してしまうことになり、実質上は問題有りません。

25行目が実行されることで、図4-1で示した日付部数式の計算結果が変わり、日付が更新されます。

6.標準モジュール(Module1)

6-1.共有で使用する定数・変数の宣言

プロジェクト内で共通で使用する定数・変数の宣言が、図6-1です。
  1. '========== ⇩(4) 定数・変数宣言 ============
  2. Public AR As Shape                '変更矢印図形
  3. Private ARtype As Integer             '矢印図形の形(⇔:0, ←:1 , →:2  , ―:3)
  4. Private ARleft As Single              '変更矢印の左端の位置
  5. Private ARwidth As Single             '変更矢印の幅
  6. Private ARtop As Single              '変更矢印の上端
  7. Private ARheight As Single            '変更矢印の高さ
  8. Private ARrow As Long              '変更矢印の行位置
  9. Private Const Scol As Long = 5          '開始日の列位置
  10. Private Const Ecol As Long = 6          '完了日の列位置
  11. Private Const Drow As Long = 2          '日付の行位置
  12. Private Const DstartCol As Long = 7       '日付開始列
  13. Private Const Dwidth As Long = 14        '日付の列数(幅:2週間だったら14日)
  14. Private Const stdDay As String = "D2"       '基準日
  15. Public Const PlusWeek As String = "E2"      'プラス週数
  16. Private myGrid As Boolean            'ユーザーの元のGrid条件
図6-1

30行目は、操作する矢印図形を変数「AR」(Arrowの略のつもり)と置き、今回システムの中ではARの寸法・位置を随所で使用しています。またその矢印形状については、図2-5でも説明したように3種類あり、開始日・完了日とも表示日付範囲に入っていないもの(タイプ3)も含め、31行目でARtypeという変数名で表すことにしました。

33~37行目は、図6-2(茶色の寸法部分)のように図形のサイズと位置を表す変数として宣言しています。図形のLeft等のプロパティのデータ型はSingle型なので、同型としました。
また37行目のARrowは矢印図形の行位置を保存するものです。矢印図形を表示中にユーザーが行高さを変更した時に、この値を使って矢印図形の上下方向の位置・図形の高さを修正します。
39~43行目は、図6-2(赤色の寸法・指示部分)のようにワークシート上の位置を表しています。

「矢印取消」ボタンへのマクロ設定
図6-2

45~46行目は、表示日付(今回は2週間分)の数式の元となっている「基準日(stdDay)」と「加える週の数(PlusWeek)」をセル位置として定数宣言(String型)しています。
Range型の変数として宣言する方法もありますが、今回システムの場合は起動ボタンのようなものがありません。「ThisWorkbookモジュール」に「Workbook_Open」イベントプロシージャを作りセル範囲を変数に代入する、という手もありますが面倒なので、String型の定数で宣言することにしました。

48行目の変数「myGrid」は、ユーザーの「図形のグリッド設定条件」を記憶するものです。
今回システムでは、矢印図形を動かす時に「セル位置にはまるような感触で操作」させるために、矢印図形描画中は「グリッドをON」にさせています。しかしグリッドON-OFFはユーザー側が自由に設定するものなので、「矢印図形を描画する直前に現状のグリッドON-OFF状態を調べ、矢印図形を削除した後に元のグリッド状態に戻す」ようにしました。
変数「myGrid」は、「現状のグリッド状態」を記憶しておくものとしていますが、万一マクロエラー等で変数値が消えてしまう事を考慮し、既定値のFalseは「グリッドOFF状態(Excelの初期設定状態)」としています。

なお、この変数・定数の中で、ワークシートモジュールでも使用するのは、変数「AR」と定数「PlusWeek」のみです。ですので、その2つだけはPublicで宣言し、残りはPrivateと可視範囲を絞っています。

6-2.矢印図形のサイズ・種類を計算

ダブルクリックでBeforeDoubleClickイベント(図5-1)が起動し、ダブルクリックした位置が日程線領域内であれば、図6-3が呼び出されます。引数として、ダブルクリックしたセル範囲を受け取ります。
  1. '========== ⇩(5) 矢印図形のサイズ・種類を計算 ============
  2. Public Sub Shape_Form(Target As Range)
  3.  Dim StartDay As Date        '開始日
  4.  Dim EndDay As Date         '完了日
  5.  Dim ArrowStart As Long       '矢印の開始列
  6.  Dim ArrowEnd As Long        '矢印の完了列
  7.  StartDay = Cells(Target.Row, Scol)
  8.  EndDay = Cells(Target.Row, Ecol)
  9.  ARtype = 0
  10.  If (Cells(Drow, Target.Column) >= StartDay) And (Cells(Drow, Target.Column) <= EndDay) Then
  11.   If StartDay < Cells(Drow, DstartCol).Value Then
  12.    ArrowStart = DstartCol
  13.    ARtype = ARtype + 2
  14.   Else
  15.    ArrowStart = DstartCol + StartDay - Cells(Drow, DstartCol).Value
  16.   End If
  17.   If EndDay > Cells(Drow, DstartCol).Value + Dwidth - 1 Then
  18.    ArrowEnd = DstartCol + Dwidth - 1
  19.    ARtype = ARtype + 1
  20.   Else
  21.    ArrowEnd = DstartCol + EndDay - Cells(Drow, DstartCol).Value
  22.   End If
  23.   Set Target = Range(Cells(Target.Row, ArrowStart), Cells(Target.Row, ArrowEnd))
  24.  End If
  25.  If ARtype = 3 Then
  26.   MsgBox "日程操作は両端部で行って下さい"
  27.   Exit Sub
  28.  End If
  29.  Call Shape_Make(Target)
  30. End Sub
図6-3

52~55行目は、プロシージャ内で使用する変数宣言です。
「StartDay」と「EndDay」は、ダブルクリックした行の「開始日」と「完了日」です。プロシージャ内で何度も使われるため、57~58行目でデータを変数に取り込んでおきます。
「ArrowStart」「ArrowEnd」は、これから描画する矢印図形の「左端の列位置」と「右端の列位置」を指します。

57~58行目では、これから描画する矢印図形の「開始日」と「完了日」を変数に代入しています。
59行目は、矢印図形のタイプ(変数ARtype)の値を初期化します。システム起動後、初めて図形描画する際には変数ARtypeは既定値のゼロですが、2回目以降に描画する時には「1つ前のARtype」の値が残っていますので、初期化する必要があります。

61行目のIf文は「Cells(Drow, Target.Column) >= StartDay」且つ「Cells(Drow, Target.Column) <= EndDay」となっており、「ダブルクリックしたセルの日付(Cells(Drow, Target.Column))が、開始日と完了日の間に入っているか」という意味になります。これは図4-5の条件付き書式の数式「=AND(G$2>=$E4,G$2<=$F4)」と内容は同じです。
つまり「ダブルクリックしたセルが青色セル(日程線上)」であれば、63~77行目を実行することになります。

63~68行目は、矢印図形の左端の列位置を計算しています。
63行目のIf文「StartDay < Cells(Drow, DstartCol).Value」の内「Cells(Drow, DstartCol)」は、定数を数値に変えれば「Cells(2, 7)」となりますので、表示日付の「先頭日付」です。ですのでIf文は「開始日(StartDay)が表示日付よりも前の日付であれば」ということになります。

開始日が表示範囲よりも前であれば、矢印図形の左端列(ArrowStart)は「DstartCol(日程線領域の左端列)」になりますので、64行目では「ArrowStart = DstartCol」としています。
また、開始日が表示範囲よりも前ということは、図2-5の5行目のように「左端が垂直」となります。ですので「矢印タイプ2」ですのでARtypeには「2」を代入します。
(59行目でARtypeは初期化していますので本来は「ARtype = 2」で充分なのですが、72行目の右端の式と形を合わせるために「ARtype = ARtype + 2」としています)。

一方「開始日(StartDay)が表示日付以上(=表示されている日付の中に、開始日が存在する)」の場合は67行目が実行されます。
67行目は「ArrowStart = DstartCol + StartDay - Cells(Drow, DstartCol).Value」であり、その右辺は「日程線領域の左端列番号+開始日ー表示日付の初めの日付」となっています。
つまり「表示日付の中での開始日の列位置」を計算し、それを矢印図形の左端列(ArrowStart)に代入しています。

ここで「開始日(StartDay)が表示日付以上」の場合は「ARtype = ・・・」というコードはありません。図形の左端部が矢印になっているので「ARtype = ARtype + 0 」という式になりますが、この式は仕事をしていませんので省略しています。

このように省略できるのは、図6-4のように「矢印図形の端部形状を二進数の考え方で表している」からです。
端部が矢印型であれば「0」垂直型であれば「1」とし、左側を二進数の2桁目、右側を1桁目としています。
矢印形状の考え方
図6-4

ですので「指定しなければ矢印型」となりますので、「開始日(StartDay)が表示日付以上」の場合は「ARtype = ARtype + 0 」となります。

70~75行目は、矢印図形の右端の列位置を計算しています。
70行目の「If EndDay > Cells(Drow, DstartCol).Value + Dwidth - 1 Then」の内「Cells(Drow, DstartCol).Value + Dwidth - 1」は、「表示日付の先頭日+表示日数(今回は14日)-1」という意味になり、「表示日付の最終日」を指しています。
その表示最終日よりも「完了日」が後ろならば71~72行目を実行します。

「完了日 > 表示最終日」であるなら、矢印図形の右端は「日程線領域の右端」となりますので、71行目では変数ArrowEndには「領域の左端列位置+領域の幅ー1」である「DstartCol + Dwidth - 1」を代入します。
式が分かりにくければ「DendCol」のような「領域の右端列位置」を表す定数を作ってもOKです。ただしExcelの図形の位置・大きさを表すプロパティは「Left、Top、Width、Height」ですので、今回はこれに合わせ「領域の幅(Dwidth)」という定数を使用しています。

また、矢印図形の右端形状は垂直型となりますので、72行目で「ARtype = ARtype + 1」としています。

一方「表示最終日 >= 完了日」、つまり「表示日付の中に完了日が存在する」場合は、74行目で変数ArrowEndに「DstartCol + EndDay - Cells(Drow, DstartCol).Value」を代入してます。これは「日程線領域の左端列位置+完了日ー表示日付の初日」という意味になり、完了日の列位置を示すことになります。

ここまでで「ダブルクリックしたセルが青いセル(=日程線上をダブルクリックした)」の場合の、「どこから(ArrowStart)」「どこまで(ArrowEnd)」が日程線として表示されているかが計算できました。
この「ArrowStart」「ArrowEnd」を使って、本当は「日程線上の一部をダブルクリック」したのだが「(表示されている範囲内の)日程線全体を指定した」ことにするため、77行目で「引数として渡されたTarget」を「日程線全体」に修正します。

61~79行目までで、ダブルクリックしたセルが青いセル(=日程線上)だった場合の処理をし、端部の形状を変数ARtypeに代入してきました。タスクによっては「開始日が表示日付範囲より前」かつ「完了日が表示日付範囲よりも後ろ」という場合があるはずです。
このようなタスクの場合は、65行目と72行目の両方が実行され、結果としてARtype=2+1=3になっているはずです。つまり「両端が垂直型」です。
このようなタスクの場合、一般のスケジュール管理ソフトなどでは「移動は可能」だったりするかもしれませんが、Excelではやっかいなので今回システムでは「操作出来ない」こととしました。
ですので82行目でコメントを出し、83行目でマクロ終了させています。

ここまでは「ダブルクリックしたセルが青いセル(=日程線上)」の処理で、引数で得たTargetを「青いセル全体」に置き換えています。一方「青いセルでは無い(=日程線上では無い)」場合には、ARtypeは59行目で初期化したままですので81行目の「If ARtype = 3 Then」も該当せずに、引数で得たTarget(ダブルクリックした単一セル範囲)をそのまま保持しています。

86行目では、このTargetを引数にしてShape_Makeプロシージャ(図6-5)を呼び出して、矢印図形を作成します。
矢印図形の大きさ・位置は、引数の「Target」の大きさ・位置に合わせて作ります。

なお、もし「DstartCol」という定数を設定しない時には、「Cells(Drow, DstartCol).Value」の代わりに「Range(stdDay).Value + Range(PlusWeek).Value 」とする必要があります。これは、図4-1の表示日付の先頭セルの数式「= D2 + E2 * 7」と同じ意味になりますが、結構長い式になりますので今回は「DstartCol」という定数を設定しました。

6-3.矢印図形を作成

図6-3の86行目から呼び出されるのが図6-5です。引数としてTarget「矢印図形を描画するセル範囲」を受取ります。
  1. '========== ⇩(6)) 矢印図形を作成 ============
  2. Public Sub Shape_Make(Target As Range)
  3.  Dim ShapeType As Long    '←図形の形を表す定数値
  4.  Application.ScreenUpdating = False
  5.   Range("a1").Select
  6.  Application.ScreenUpdating = True
  7.  Call GridChange(True)
  8.  ARleft = Target.Left
  9.  ARtop = Target.Top
  10.  ARwidth = Target.Width
  11.  ARheight = Target.Height
  12.  ARrow = Target.Row
  13.  Select Case ARtype
  14.   Case 0
  15.    ShapeType = msoShapeLeftRightArrow
  16.   Case 1
  17.    ShapeType = msoShapeLeftArrow
  18.   Case 2
  19.    ShapeType = msoShapeRightArrow
  20.  End Select
  21.  Set AR = ActiveSheet.Shapes.AddShape(ShapeType, ARleft, ARtop, ARwidth, ARheight)
  22.  AR.Adjustments.Item(1) = 0.9
  23.  AR.Fill.Visible = msoFalse
  24.  AR.Line.ForeColor.RGB = RGB(0, 0, 0)
  25.  AR.Select
  26.  Call Shape_check
  27. End Sub
図6-5

92行目は矢印図形をAddShapeメソッドで作成する際に使用する「図形の種類」を宣言します。
図形には非常に多くの種類がありますが、今回使用する3種類を図6-6にまとめておきます。この表の定数値の入れ物が、変数「ShapeType」です。
矢印図形の定数
図6-6

95行目の「Range("a1").Select」は、ユーザーが矢印図形を操作する前までに実行すれば良いコードです。また、このコードは無くてもシステムとして成立するのですが、以下のような状況を考えて設けました。

ユーザーが、あるセル(ここではK6セルとします)をダブルクリックしたとします。K6セルが日程線上で無ければそのセルを囲むように矢印図形が描画されます。
1日だけのタスクであれば矢印図形を伸縮する必要もなく、任意のセルをクリックすれば日程が確定するのですが、最もクリックし易いのは「マウスを動かさずクリックできるK6セル」のはずです。
しかし、その時K6セルは選択済みで「選択セルが変更されていない」ため「SelectionChange」イベントは発生せず、開始日・完了日の書き換え処理が働きません。しかも今回システムでは、図形の動きを監視している図6-8の中で「ESCキーで図形からFocusが外れた処理(142行目)」をしているため、「ESCキーを押して、処理をキャンセルした」のと同等の操作となってしまいます。

ですので、矢印図形を操作している時には「ダブルクリックと同じセルを選択しても、開始日・完了日の処理が出来る」ように、「ユーザーが、日程確定のためには選択しないであろうセル位置(=A1セル)」に選択セル位置を移動させています。

なお95行目「Range("a1").Select」を、94行目と96行目の「Application.ScreenUpdating = False/True」で囲んでいます。つまり「A1セルを選択した事を画面更新しない」という意味です。
これは、スケジュール表が縦や横に長くなり、A1セルが見えない場所で図形操作をした時、画面更新を一時停止していないと「A1セルが見える状態まで画面がスクロールし、操作している部分か視界から消えてしまう」現象が起こります。
その画面スクロールを防止するには、常にA1セルが見えるように「ウィンドウ枠の固定」で「タイトル部を固定」する方法もありますが、今回は「セル選択の間だけ画面更新停止」する方法にしてみました。
なお「ウィンドウ枠の固定」とよく似た「表示領域の分割」では画面スクロール現象は防止できないようです。

98行目は、図6-29の「矢印図形のグリッド吸着(GridChange)」を呼び出しています。引数に「True」を指定することで、「現在のグリッド設定を記憶した上で、図形のグリッド吸着をON」にする設定になります。詳細は図6-29で説明します。

100~104行目は、プロジェクト内で共有して使用する変数「ARleft」「ARtop」「ARwidth」「ARheight」「ARrow」に値を代入します。ARは115行目で作成する矢印図形のことで、そのサイズと位置を示している変数ですが、セルに沿った大きさ・位置で作成するため、引数のTarget(矢印図形を描画するセル範囲)のプロパティをそのまま使用しています。

106~113行目では、図6-3で計算した矢印図形の形状(ARtype)を「AddShapeメソッドの図形の種類」の値に置き換えます。
図6-6で示した定数を変数ShapeTypeに代入します。

115行目では、AddShapeメソッドを使い実際に矢印図形を作成します。作成した図形はオブジェクト変数「AR」という名前で管理していきます。

作成した図形は、そのままでも良いのですが、操作性・見栄えも考えて少し加工します。
まず117行目では矢印図形の軸部分を太くします。図形を調整には、図6-7のように図形のAdjustmentsで操作します。
矢印図形のAdjustmentsにはItem(1)とItem(2)の2種類があり、太さを変更するにはItem(1)の値(既定値0.5)を大きくします(最大で1.0)。今回は「少しだけ矢印の耳を残した」0.9を設定しています。
矢印図形の調整オブジェクト
図6-7

太くしたのには理由があります。矢印図形を移動・伸縮し確定するために任意セルを選択しますが、「矢印図形が乗っているセルを選択」しようとすると、既定の太さの矢印図形では「図形を選択」したことになってしまい、うまくセルが選択できないことになります。
たぶんマウスのマークのサイズや、セルの高さなども影響するのでしょうが、「軸部分を太く」しておけば、図形の下のセルに触れやすくなるようです。

118行目の「AR.Fill.Visible = msoFalse」は、図形の「塗りつぶしなし」を選択するのと同等のものです。
元の日程線(青いセル範囲)が見易くなるのと併せて、上記の「矢印図形が乗っているセルをクリックし易くする」ために塗りつぶしなしにしています。

119行目の「AR.Line.ForeColor.RGB = RGB(0, 0, 0)」は、枠線の色を黒色にしています。これは趣味だけです。
最後に120行目で「AR.Select」とし、図矢印図形を選択した状態で「ユーザーの操作」を待ちます。

これで矢印図形の描画が完成しましたので、122行目で「図形監視(Shape_check)」プロシージャ(図6-8)に仕事を引き継ぎます。

6-4.矢印図形の変形を監視

図6-5の122行目から呼び出されるのが図6-8です。内部ではDo~Loopで図形の変化を監視し続けます。
  1. '========== ⇩(7) 矢印図形の変形を監視 ============
  2. Private Sub Shape_check()
  3.  Application.EnableCancelKey = xlErrorHandler
  4.  On Error GoTo myErr
  5.   Do Until AR Is Nothing
  6.    If AR.Top <> ARtop Or AR.Height <> ARheight Or Not AR.Rotation = 0 Then
  7.     Call ARverticalFix
  8.    End If
  9.    If AR.Left <> ARleft Or AR.Width <> ARwidth Then
  10.     Call ARcellFix
  11.     Call ARareaFix
  12.    End If
  13.    If Not VarType(Selection) = vbObject Then
  14.     If Selection = Range("a1") Then
  15.      Err.Number = 18
  16.      GoTo myErr
  17.     End If
  18.    End If
  19.    DoEvents: DoEvents
  20.   Loop
  21.  On Error GoTo 0
  22.  Application.EnableCancelKey = xlInterrupt
  23.  Call GridChange(False)
  24.  Exit Sub
  25. myErr:
  26.  If Err.Number = 18 Then
  27.   AR.Delete
  28.   Set AR = Nothing
  29.  ElseIf Err.Number = 424 Then  '手動で図形を削除されてしまった時
  30.   Set AR = Nothing
  31.  Else
  32.   MsgBox Err.Description
  33.  End If
  34.  Call GridChange(False)
  35. End Sub
図6-8

図形には「Shape_Change」のようなイベントが無いため、Do~Loopを使って監視をします。ですので、このShape_checkプロシージャのメインの仕事は「図形の変形を監視(133行目および137行目)」です。その結果、縦方向の変形・移動があれば「元に戻す修正(134行目)」をし、また横方向の変形・移動があれば「その変形が正しい変形か、正しくなければ形を修正(138~139行目)」することです。

しかしDo~Loopが回っている最中に、ユーザーが操作をキャンセルしようと「ESCキー」が押されたり、「図形をDeleteキー等で削除」してしたりということは想定しておく必要がありますので、その分のコードが多くを占めることになってしまいます。

6-4-1.エラー処理の設定

127行目の「Application.EnableCancelKey = xlErrorHandler」は「ESCキー(またはCtrl+Breakキー)」が押された時の動作を指示するものです。図6-9のように3種あり、127行目では「xlErrorHandler」を指定していますので、ESCキーを押すとエラーが発生することになります。(エラー番号で正常処理するのが目的です)
EnableCancelKeyプロパティ
定数内容
xldisabled0Escキーを無視
xlErrorHandler2エラーを発生。エラーコード=18
xlInterrupt1(既定)プロシージャを停止
図6-9

そして127行目の設定を生かすため、129行目で「On Error GoTo myErr」と「エラー発生時はmyErrへ飛ぶ」設定をします。

6-4-2.監視実行

131~152行目のDo~Loop内で、矢印図形の変形を監視することになりますが、その継続条件は131行目の「Until AR Is Nothing」と「AR(矢印図形)が無くなるまでDo~Loopを続ける」ことにしています。

監視場所は2箇所あります。監視の1箇所目は133行目、2箇所目は137行目です。
まず、1箇所目の133行目「If AR.Top <> ARtop Or AR.Height <> ARheight Or Not AR.Rotation = 0 Then」は、
 ・「AR.Top <> ARtop」:図形の上端が、前回と異なる
 ・「AR.Height <> ARheight」:図形の高さが前回と異なる
 ・「Not AR.Rotation = 0」:図形が回転した
の3項目を監視しています。この3つのどれかが当てはまる時、134行目で「ARverticalFix(図6-10)」を呼出し、「Top」値、「Height」値、「Rotation」値を修正します。
なお図形のTop値等が変更されるのは、ユーザーが図形を動かした時だけではありません。ユーザーが「行の高さを変更」した時にも図形の上下方向のプロパティ値に変化が生じます。そのため、修正には変数ARrow値(何行目のデータか)を使い「常にダブルクリックした行の上に図形がある」ようにしています。

監視の2か所目は137行目です。If文は「If AR.Left <> ARleft Or AR.Width <> ARwidth Then」と、
 ・「AR.Left <> ARleft」:図形の左端位置が前回と異なる
 ・「AR.Width <> ARwidth」:図形の幅が前回と異なる
の2項目を監視しています。この2つのどれかが当てはまる時、138~139行目を実行します。

138行目から呼び出す「ARcellFix(図6-11)」では、図形をセル境界にピッタリと沿うように微調整します。
また139行目から呼び出す「ARareaFix(図6-15)」は、日程線領域をはみ出したり逆転したりしている図形を「開始日・完了日計算に支障の無いように図形の位置・サイズを調整」します。
当初「ARareaFix」のみで試行していたのですが、グリッド吸着でもセル境界にピッタリ合わない場合があったり、日程線領域の各列幅がバラバラな状態 も想定して、先に「ARcellFix」でセル境界に合うように微調整してから大きな形状修正をすることにしました。

なお、監視に使用している変数「ARtop」「ARleft」「ARwidth」「ARheight」は、「矢印図形を手動で動かす前の位置・サイズ」です。

6-4-3.ESCキーの処理

142行目の「If Not VarType(Selection) = vbObject Then」は、実は「ESCキーを押した時」の処理です。
127行目の「Application.EnableCancelKey = xlErrorHandler」のところで、矢印図形が描画されている時に「ESCキー」が押されるとエラー番号18が発生する説明をしました。129行目で「On Error GoTo myErr」としていますので、ESCキーを押すとmyErrへ飛ぶはずです。しかし、今回システムの場合「ESCキーでエラー番号18は、ほとんど発生しない」のです。

理由を考えてみました。通常ESCキーを押してプログラムが中断するのは、Excelが一生懸命にマクロコードの処理をしている最中です。
今回システムに置き換えれば「ユーザーが動かした矢印図形を、プログラムが位置・サイズ修正している最中」です。しかしプログラムにしてみれば、その処理さえも瞬時に完了させてしまうため、実質Do~Loop内で動いているコードは133行目と137行目の「図形が動いたか否か」の判断だけの非常に軽い処理です。
ですので、プログラムが修正している最中を狙ってESCキーを押してさえも、なかなかエラー番号18は発生しません。現在のPCは処理速度が早いこともあり、ほとんどは150行目の「DoEvents」のところでESCキーが実行されている感じです(私の感触)。

DoEventsの場所でESCキーが実行されると、それまで選択していた矢印図形からセル(図6-5の95行目でSelectしたA1セル)に選択が移動します。手動でも「図形を選択した状態からESCキーを押すと、図形からはFocusが外れてセルへ移る」事が確認できます。
これを利用し、142行目の「VarType(Selection)」で「選択しているものの種類」を調べ、それが矢印図形「vbObject」でなかったら(セル選択の場合はNothingになります)、145~146行目のエラー処理への準備・移動をすることにしました。

ただし通常操作で「矢印図形の日程を確定しようとして、任意のセルをクリック」した時に、丁度142行目の「VarType(Selection)」を評価してしまうと、「日程を確定したつもりが、キャンセル扱いになってしまった」ということになってしまいます。
ですので「ESCキーで図形からFocusが外れた証拠」として144行目で「If Selection = Range("a1") Then」の条件式を入れました。
試行段階では、任意のセルをクリックした時には142~144行目よりも「SelectionChangeイベントの方が早く実行される」ようですが、確証が取れないので144行目は外さずにおいてあります。

ということで、ESCキーを押すとほとんどが142行目で引っ掛かり、図6-5の95行目で図形描画前にA1セルに移動済みですので、144行目の「If Selection = Range("a1") Then」も成立し145~146行目を実行します。
145行目は、ESCキーがエラー番号18を発してエラーとなった時と合わせるため「Err.Number = 18」と強制的にエラー番号を付け、146行目では129行目の代わりに「GoTo myErr」と162行目へ飛ばしています。

但しこの手法を使えるのは、今回のような「図形を選択させて」から「ESCキーが押される」ことにより「図形から選択が外れる」というような状況にしか使えません。通常のセル操作中のESCキー検出などでは別な方法が必要と思います。

150行目は、O/S側に処理を渡しています。この間でユーザーは図形操作をしていることになります。

6-4-4.Do~Loopを抜けたあとの処理

ユーザーが矢印図形を操作している間は131~152行目のDo~Loopの中を回っていますが、任意のセルを選択すると開始日・完了日データを書き込み、その後矢印図形を削除します。
すると131行目のDo~Loopの終了条件「Until AR is Nothing」が成立するためDo~Loopから抜け出します。

抜け出した後は、154行目の「On Error GoTo 0」でエラー発生時の飛び先を解除し、156行目でESCキーの「EnableCancelKeyプロパティ」を既定の「xlinterrupt」に戻します。
両方ともマクロが終了すれば、勝手に元に戻ってくれるようですが、自分で設定したものは自分で解除しておくべきと考えます。

その後158行目で「GridChange」を呼出します。引数に「False」を指定していますので、グリッド吸着有無を元のユーザー環境に戻します。(矢印図形描画前にグリッド吸着有りにしてあれば、吸着解除をしないことになります。)
最後に160行目の「Exit Sub」でプロシージャを終了します。

6-4-5.エラー発生時の処理

129行目の「On Error GoTo myErr」と154行目の「On Error GoTo 0」の間でエラーが発生した場合は162行目のmyErrラベルに飛びます。通常のエラーのみで無く、142~148行目のESCキーを押した時の疑似エラーもmyErrラベルに飛びます。

164~174行目では、エラー番号で仕分けて処理をします。
まず164行目の「If Err.Number = 18 Then」が成立するのは、エラー番号が18の時です。
それに当てはまる条件の1つ目は、「ESCキーを押した」時に内部処理中(=図形の位置・サイズの計算など)だった時です。その時は127行目の設定(Application.EnableCancelKey = xlErrorHandler)によりエラー番号18が発生します。
条件のもう1つは、「ESCキーを押した」事により矢印図形から選択が外れ、145行目の「Err.Number = 18」によりエラー番号が18になった時です。
その場合は165~167行目を実行します。

まず165行目の「AR.Delete」で矢印図形(AR)を削除し、166行目の「Set AR = Nothing」でARオブジェクトを解放します。
実は図形を削除しただけでは「ARオブジェクト」は残っています。
ですので、ここで解放をしておかないと「図形をESCキーでキャンセルしたのち、どこかのセルをクリック」した時に、図5-2の14行目の「If Not AR Is Nothing Then」が成り立ってしまい、矢印図形の実体が無いのに15行目の「Data_Fix」プロシージャを呼び出してしまいます。Data_Fixは、矢印図形ARの位置・サイズから開始日・完了日を計算する工程ですので、オブジェクトが存在しないことでエラーが発生します。

次に168行目の「ElseIf Err.Number = 424 Then」ですが、これは「選択している矢印図形をユーザーがDeleteキーで削除してしまった」事を想定しています。
Do~Loop内では、133~135行目で矢印図形(ARオブジェクト)の位置・サイズを常時監視していますが、図形削除でそのARオブジェクトが消えてしまうと実行時エラー「オブジェクトが必要です」が発生し、129行目の「On Error GoTo myErr」に従って、エラー処理部に飛んできます。この時のエラー番号は424です。
このエラーでの処理は、オブジェクト(AR)はユーザーによって既に削除済みですので、169行目の「Set AR = Nothing」でARオブジェクト開放のみをします。

それ以外のエラー(いわば本当のエラー)の場合は、172行目の「MsgBox Err.Description」でエラー内容を表示して終了します。
最後に176行目で「GridChange(False)」を呼出し、グリッド環境をユーザー仕様に戻します。

6-5.矢印図形の上下方向の位置・サイズを元に戻す

図6-8の134行目から呼び出されるのが図6-10です。
  1. '========== ⇩(8) 矢印図形の位置をセル単位に補正 ============
  2. Private Sub ARverticalFix()
  3.  AR.Rotation = 0
  4.  ARheight = Cells(ARrow, 1).Height
  5.  ARtop = Cells(ARrow, 1).Top
  6.  AR.Height = ARheight
  7.  AR.Top = ARtop
  8. End Sub
図6-10

このプロシージャ内では、図形の以下の3つのプロパティを修正をしています。
 ・図形の回転(Rotation:183行目)
 ・図形の高さ(Height:186行目)
 ・図形の上下方向の位置(Top:187行目)

そしてその修正値となるのが、変数ARheight・ARtopです。
通常、矢印図形だけを操作している時は「ARheight・ARtopは不変」ですが、矢印図形が表示されている最中に「図形よりも上にある行の高さを変更」した時には「図形の上下方向の位置・図形の高さが変更」されてしまいます。
但し変数ARrow(操作している行位置)は不変ですので、その値を使って184行目の「ARheight = Cells(ARrow, 1).Height」と185行目の「ARtop = Cells(ARrow, 1).Top」とで変数ARheight・ARtopを書き換えています。
なお、Rotation値は常にゼロにしています。

また、この実行順番には意味があります。
実は図形を変形(今回は上下方向)させたのち、まずTopを修正し次にHeightを修正すると、修正した図形のTopがまた少しだけズレる(私のPCでは0.00008 ポイント)現象が時々発生するのです。(なお修正する順番を「Height → Top」にしても、Heightがズレることは今のところ確認されていません)
なお、回転方向の修正順序で、Topがズレる現象は(今のところ)発生しませんでした。

ですのでこの「上下方向の修正」では、影響の無い(少ない)「Height」と「Rotation」の修正を先に実行し、「Topを最後に修正することで、ズレを無くす(少なくする?)」ことにしました。

6-6.矢印図形の位置をセル単位に補正する

図6-8の138行目から呼び出される「矢印図形の位置をセル単位に補正」するプロシージャが図6-11です。
  1. '========== ⇩(9) 矢印図形の位置をセル単位に補正 ============
  2. Private Sub ARcellFix()
  3.  Dim ARscol As Range        '←矢印図形の左端が含まれるセル(ARのstart columnの略)
  4.  Dim ARecol As Range        '←矢印図形の右端が含まれるセル(ARのend columnの略)
  5.  If AR.TopLeftCell.Left + AR.TopLeftCell.Width / 2 < AR.Left Then
  6.   Set ARscol = AR.TopLeftCell.Offset(0, 1)
  7.  Else
  8.   Set ARscol = AR.TopLeftCell
  9.  End If
  10.  If AR.BottomRightCell.Left + AR.BottomRightCell.Width / 2 < AR.Left + AR.Width Then
  11.   Set ARecol = AR.BottomRightCell.Offset(0, 1)
  12.  Else
  13.   Set ARecol = AR.BottomRightCell
  14.  End If
  15.  AR.Width = ARecol.Left - ARscol.Left
  16.  AR.Left = ARscol.Left
  17. End Sub
図6-11

セル境界にピッタリとした図形では、図6-12のように「図形の左端(TopLeftCellプロパティ)」は「オレンジ色のセル」を指し、「図形の右端(BottomRightCellプロパティ)」は「緑色のセル」を指します。
オレンジ色の方は感覚的に合いますが、緑色の方は1つズレている感じがします。しかし、セル幅にピッタリ収まっている図形では「図形の右端位置(図形のLeft + 図形のWidth)」と「緑色セルのLeft」とは同じ値です。
セル幅にピッタリした図形
図6-12

今回システムも図形端部の位置とセルの位置の値を比較して、図6-15のARareaFixプロシージャで「図形の左端・右端が矢印エリアをオーバーしていないか」、また図6-27のData_Fixプロシージャで「図形の左端・右端がどの日付を指しているか」を計算しています。
ですので、その処理の前に「図形をセル幅ピッタリに微調整」しておくのが、このARcellFixプロシージャの役目です。

微調整の考え方ですが、図6-13のように「左端・右端が属するセルの、近い方の端部に合わせる」ようにしました。
図形のズレと補正する方向
図6-13

左端の位置把握と調整する位置の計算が、図6-11の196~200行目です。
196行目の「If AR.TopLeftCell.Left + AR.TopLeftCell.Width / 2 < AR.Left Then」の内「AR.TopLeftCell.Left」が図6-13の(B)、「AR.TopLeftCell.Width / 2」が(A)/2 に相当します。ですので「(C)の位置」と「図形の左端(赤い点)」を比較することになり、赤い点の方が遠い(=線(C)よりも右側にある)場合(図6-13の(2))に197行目を実行します。

(2)の場合197行目の「Set ARscol = AR.TopLeftCell.Offset(0, 1)」で、一つ右側のセルを変数ARscolに代入します。
赤い点の方が近い(=線(C)よりも左側にある)場合(図6-13の(1))は、199行目「Set ARscol = AR.TopLeftCell」で、左端が属するセルを変数ARscolに代入します。

一方、右端の位置把握と調整する位置の計算が、202~206行目です。
202行目の「If AR.BottomRightCell.Left + AR.BottomRightCell.Width / 2 < AR.Left + AR.Width Then」の内、「AR.BottomRightCell.Left + AR.BottomRightCell.Width / 2」は、やはり図6-13の(C)の閾線を表します。また「AR.Left + AR.Width」は、図形の右端(緑の点)になりますので、緑の点の方が遠い(=線(C)よりも右側にある)場合(図6-13の(4))に203行目を実行します。

(4)の場合は203行目の「Set ARecol = AR.BottomRightCell.Offset(0, 1)」により、現在右端が属しているセルの一つ右側のセルをARecolに代入します。
また(3)の場合には205行目の「Set ARecol = AR.BottomRightCell」で現在右端が属しているセルをARecolに代入します。

上記で得られた「ARscol」「ARecol」を使って、208~209行目で「セル境界に沿った図形」に微修正していきます。
図6-14のように「ARscol(オレンジ色のセル)」と「ARecol(緑色のセル)」が196~206行目で求められたので、208行目の「AR.Width = ARecol.Left - ARscol.Left」では、図形ARのWidthに「ARecolとARscolの横方向の差」を設定します。
また209行目の「AR.Left = ARscol.Left」で、図形ARのLeftに「ARscolのLeft値」を設定します。

両端セルを使って図形を微修正
図6-14

Leftの設定をWidthの後ろで実行しているのは、図6-10でTopの設定をHeightの設定の後で実施しているのと同じ理由です。Left→Widthの順番だとLeftがズレてしまう現象が、私のPCですと10~20回に1回発生していました。
順番を変更しWidth→Leftの順番にすると、100回ほど確認しましたが1回も発生せず、効果はありそうです。このあとのARareaFixプロシージャなどでも、この順番で実行していきます。

これで「セル境界に沿った図形」への修正が完了です。

6-7.矢印図形が変形された時の処理

図6-8の139行目から呼び出される「日程線領域からはみ出した図形の修正等」を行うプロシージャが図6-15です。
  1. '========== ⇩(10) 図形のはみ出し等を修正 ============
  2. Private Sub ARareaFix()
  3.  Select Case ARtype
  4.   Case 0
  5.    If ((AR.Left + AR.Width) > Cells(1, DstartCol + Dwidth).Left) And AR.Left = ARleft Then   '(0-1)
  6.     AR.Width = Cells(1, DstartCol + Dwidth).Left - ARleft
  7.     ARwidth = AR.Width
  8.    ElseIf (AR.Left < Cells(1, DstartCol).Left) And AR.HorizontalFlip = True Then   '(0-2)
  9.     AR.Flip msoFlipHorizontal
  10.     AR.Width = ARleft - Cells(1, DstartCol).Left
  11.     AR.Left = Cells(1, DstartCol).Left
  12.     ARleft = AR.Left
  13.     ARwidth = AR.Width
  14.    ElseIf (AR.Left < Cells(1, DstartCol).Left) And (AR.Left + AR.Width) = (ARleft + ARwidth) Then   '(0-3)
  15.     AR.Width = ARleft + ARwidth - Cells(1, DstartCol).Left
  16.     AR.Left = Cells(1, DstartCol).Left
  17.     ARleft = AR.Left
  18.     ARwidth = AR.Width
  19.    ElseIf (AR.Left + AR.Width) > Cells(1, DstartCol + Dwidth).Left And AR.HorizontalFlip = True Then   '(0-4)
  20.     AR.Flip msoFlipHorizontal
  21.     AR.Width = Cells(1, DstartCol + Dwidth).Left - AR.Left
  22.     AR.Left = ARleft + ARwidth
  23.     ARleft = AR.Left
  24.     ARwidth = AR.Width
  25.    ElseIf AR.Left < Cells(1, DstartCol).Left Then   '(0-5)
  26.     AR.Width = ARwidth
  27.     AR.Left = Cells(1, DstartCol).Left
  28.     ARleft = AR.Left
  29.     ARwidth = AR.Width
  30.    ElseIf (AR.Left + AR.Width) > Cells(1, DstartCol + Dwidth).Left Then   '(0-6)
  31.     AR.Width = ARwidth
  32.     AR.Left = Cells(1, DstartCol + Dwidth).Left - ARwidth
  33.     ARleft = AR.Left
  34.     ARwidth = AR.Width
  35.    ElseIf AR.Left <> ARleft Or (AR.Left + AR.Width) <> (ARleft + ARwidth) Then   '(0-7)
  36.     If AR.HorizontalFlip = True Then AR.Flip msoFlipHorizontal
  37.     ARleft = AR.Left
  38.     ARwidth = AR.Width
  39.    End If
  40.   Case 1
  41.    If AR.HorizontalFlip = True And AR.Left + AR.Width >= Cells(1, DstartCol + Dwidth).Left Then   '(1-1)
  42.     AR.Flip msoFlipHorizontal
  43.     AR.Width = 0
  44.     ARwidth = AR.Width
  45.     AR.Left = Cells(1, DstartCol + Dwidth).Left
  46.     ARleft = AR.Left
  47.    ElseIf AR.HorizontalFlip = True Then   '(1-2)
  48.     AR.Flip msoFlipHorizontal
  49.     AR.Width = ARwidth
  50.     AR.Left = ARleft
  51.    ElseIf (AR.Left + AR.Width) <> (ARleft + ARwidth) Then   '(1-3)
  52.     AR.Width = ARwidth
  53.     AR.Left = ARleft
  54.    ElseIf AR.Left < Cells(1, DstartCol).Left Then   '(1-4)
  55.     AR.Width = Cells(1, DstartCol + Dwidth).Left - Cells(1, DstartCol).Left
  56.     ARwidth = AR.Width
  57.     AR.Left = Cells(1, DstartCol).Left
  58.     ARleft = AR.Left
  59.    ElseIf R.Left <> ARleft Then   '(1-5)
  60.     ARwidth = AR.Width
  61.     ARleft = AR.Left
  62.    End If
  63.   Case 2
  64.    If AR.HorizontalFlip = True And AR.Left < Cells(1, DstartCol).Left Then   '(2-1)
  65.     AR.Flip msoFlipHorizontal
  66.     AR.Width = 0
  67.     ARwidth = AR.Width
  68.     AR.Left = Cells(1, DstartCol).Left
  69.     ARleft = AR.Left
  70.    ElseIf AR.HorizontalFlip = True Then   '(2-2)
  71.     AR.Flip msoFlipHorizontal
  72.     AR.Width = ARwidth
  73.     AR.Left = ARleft
  74.    ElseIf AR.Left <> ARleft Then   '(2-3)
  75.     AR.Width = ARwidth
  76.     AR.Left = ARleft
  77.    ElseIf AR.Left + AR.Width > Cells(1, DstartCol + Dwidth).Left Then   '(2-4)
  78.     AR.Width = Cells(1, DstartCol + Dwidth).Left - ARleft
  79.     ARwidth = AR.Width
  80.    ElseIf (AR.Left + AR.Width) <> (ARleft + ARwidth) Then   '(2-5)
  81.     ARwidth = AR.Width
  82.    End If
  83.  End Select
  84. End Sub
図6-15

図形の修正方法は、矢印図形の種類によって大きく違いますので、プロシージャ内では「ARtype」によってプログラムを分けています。
両矢印(ARtype=0)の場合は218~252行目、左矢印(ARtype=1)の場合は、255~276行目、右矢印(ARtype=2)の場合は、279~297行目を実行します。

6-7-1.両矢印(ARtype=0)の処理

両矢印の場合の、左右方向に移動・変形したとき「どのような形になるか」を図6-16にまとめました。
3列に分けていますが、左列が「矢印図形の右端をクリックして変形」した時の形状、中央が「矢印図形の左端をクリックして変形」した時の形状、右列が「矢印図形全体をクリックして移動」した時の形状です。
また矢印図形の変形結果によっては「領域の左端・右端」をオーバーしますが、今回システムではオーバーは困りますので「領域内に引き戻す」必要があります。その引き戻した時の形状を「赤い点線」で表しています。
両矢印図形を動かすパターン一覧
図6-16

このプロシージャは「領域内に収まるように図形を修正」するのが目的ですので、この図6-16の「赤い点線の修正内容」をパターン毎にまとめたのが図6-17です。
両矢印図形の変形修正方法一覧
図6-17

また変形状態を「プログラム的に発見する方法」をまとめたのが図6-18です。
これ以外にも発見の方法はあると思いますが、すぐに思いつきそうなものだけで表を作りました。
両矢印図形の変形状態を見つける方法一覧
図6-18

この「図6-17」と「図6-18」の2つの表から、プログラム的に「領域をはみ出した時に、どのような形状で変形させるか」を導く必要があります。しかし、この別々な表からでは難しいので、図6-19のように合体してみます。
両矢印図形の変形方法と発見方法を合体した表
図6-19

図形を変形させる内容を上側にA~Gに、発見する条件を下側に1~8にしてあります。「発見する条件=変形内容」ではありませんので、「発見する条件を組み合わせ」て変形内容のパターンを抽出する必要があります。
恐らく色々な方法が存在するはずですが、私ならまず「上側の表で白丸の数の少ない行」を選び、「下側の表でその白丸の列を含み、且つ黒丸の数の少ない行」を見つけます。
例えば、上の表のB行はパターン2のみで、下の表でパターン2を含み数の少ないのは6行目です。しかし6行目にはパターン12、16,17も含まれていますので、次に下の表で「パターン2は含んで、パターン12,16,17は含まれない」または「パターン2は含まないでパターン12,16,17は含む」行を探します。
すると2行目が「パターン2は含まないでパターン12,16,17は含む」行に相当しますので、「B行を検出する条件」は「6行目の検出方法 ー 2行目の検出方法」となり、数式っぽく表すとすれば「(6) And Not(2)」となります(一番右の『パターンを絞り込む式』列)。

他の変形方式についても同様に考え、絞り込む式を作っていきますが、B行目のように「一度作った絞り込み式も発見する条件式」として考えていきます。例えばG行目ではB行目の結果を入れて「(6) And Not(B) And Not(E)」としています。
もし、どう考えても絞り込む式が立てられない場合は、下側の条件を増やすことを考えます。

次に、このようにして作った「パターンを絞り込む式」の実行順序を考えていきます。
式は「全て下の表の『発見する条件式』から作成」されていますので、「A~Gの結果を使用しない」のであればどの順番でもOKです。但し「A~Gの結果を使用する」のであれば、順番を考える必要が出てきます。

Excelでは「If~ElseIf~・・・」と条件式を何段にも重ね書き出来ますが、上流で条件が合致したものは、下流側でまた合致したとしても二度と実行されません。この特性を使い、例えば「Bの結果を使っている条件式」は「Bの条件式」よりも下に持ってくることで「Bの結果を外す」ことができるのです。

今回図6-19でもA~Gの結果を使っている条件式は3つ(A、F、G)ありますので、それぞれが実行された後にもってくるように考え並べると、図6-20のような順番になります。(この順番も色々なパターンが考えらえると思います)
両矢印図形の処理順番
図6-20

図6-20で薄い色にしている部分は「既に実行されていて対象外」になっている部分です。
この順番で「If~ElseIf~・・・」を並べたのが、218~252行目になります。

まず、図6-20の順番1は「図形右端が領域右端をオーバー(Right > E)し、且つ図形左端が移動していない」ですので、式は「((AR.Left + AR.Width) > Cells(1, DstartCol + Dwidth).Left) And AR.Left = ARleft」としました。「Right > E」が「(AR.Left + AR.Width) > Cells(1, DstartCol + Dwidth).Left」に該当します。
矢印図形の右端位置は、直接は求められませんので「左端位置+図形幅」で表します。領域右端の「E」は「Cells(1, DstartCol + Dwidth).Left」となります。

また「Leftが移動していない」は、単純に「AR.Left = ARleft」としました。
ARcellFitプロシージャ(図6-11)で矢印図形をセル境界に合わせる際に「もしズレが発生」してしまったら、との心配は残りますが、試してみたところズレが出ることは無かったので、今回は誤差が出ないことを前提に式を立てました。

なお「図形右端が領域右端をオーバー」を「>」と「>=」のどちらにするかですが、今回プログラムでは「>」を使用しました。
図6-16の②だけを見れば、図形を引き延ばして「ちょうど領域右端で止めた」時には「含めない(>)」を使った方が処理が少なく良さそう ぐらいの理由と思われがちです。
しかし「>=」を順番1~6の全てに適用(順番7は<>なので)してしまうと、例えば領域の右端に「幅ゼロ」の図形がある時に内側に引き延ばそうと変形させても、思惑と異なるElseIf文(この場合は順番6)が反応してしまい、図形を伸ばす事が出来なくなってしまうのです。
イコールの無い「>」では今のところ不具合が見つかっていないので今回は「>」を統一して使っていますが、図形の変化を網羅できていない可能性もありますので、もし変な動きをする状態が見つかったらごめんなさい。

順番1で図形に対して行う処理は「右端を領域の右端に+左端はそのまま(図6-16の②)」ですので、AR.Leftはそのままにして、219行目で「AR.Width = Cells(1, DstartCol + Dwidth).Left - ARleft」と、領域の右端位置(Cells(1, DstartCol + Dwidth).Left)から図形左端を引いた長さを図形幅としています。
また220行目では、変更になったAR.Width値を変数ARwidthに代入します。なお変更されない図形左端位置(変数ARleft)は変更しません。

順番2は図6-20で「Left<S And 反転している」ですので、221行目で「 (AR.Left < Cells(1, DstartCol).Left) And AR.HorizontalFlip = True」としています。図形の反転は、HorizontalFlipプロパティがTrueかFalseかで判断できます。

実行内容は「左端をSにし、右端は元の図形左端(ARleft)にする(図6-16の⑥)」で、222~226行目を実行します。
まず222行目の「AR.Flip msoFlipHorizontal」で反転を戻します。両端矢印ですので、反転を戻さなくても形状的には大丈夫なのですが、HorizontalFlipプロパティがTrueのままだと「もう一度反転された時に、発見条件に合わなくなる」ので元に戻しておく必要があります。
223行目の「AR.Width = ARleft - Cells(1, DstartCol).Left」では、元の左端から現在の左端の距離を、新しい図形の幅にしています。これにより「右端は元の図形左端(ARleft)にする」が達成できます。
224行目の「AR.Left = Cells(1, DstartCol).Left」では、図形の左端を領域の左端にしています。

223行目と224行目におなじ「Cells(1, DstartCol).Left」を使っています。224行目を先に実行すれば、223行目は「AR.Width = ARleft - AR.Left」とスッキリするのですが、図6-10で説明したように図形のTop位置にズレが発生し易いのと同様に、Left位置にもズレが発生し易いので、Leftの設定は出来るだけ後で実行するようにしています。
225行目の「ARleft = AR.Left」と226行目の「ARwidth = AR.Width」で、新しい図形の現在位置の変数値を置き換えています。

順番3は「Left<S And Rightが移動していない」ですので、227行目で「(AR.Left < Cells(1, DstartCol).Left) And (AR.Left + AR.Width) = (ARleft + ARwidth)」としています。「移動していない」は218行目のIf文と同様に、ズレが出ないことを前提にしています。

実施内容は「左端をSに合わせ、右端は元の図形の位置にする(図6-16の⑧)」で、228~231行目を実行します。
まず228行目の「AR.Width = ARwidth + (ARleft - Cells(1, DstartCol).Left)」は、右端を固定するため矢印図形の幅を計算しています。図6-16の⑧を見て分かる様に、元の図形の左端(ARleft)と領域左端(Cells(1, DstartCol).Left)との差に、元の幅(ARwidth)を足すことで新たな図形の幅が求まります。
次に229行目の「AR.Left = Cells(1, DstartCol).Left」で図形左端を領域の左端に合わせます。
最後に、230行目の「Rleft = AR.Left」と231行目の「ARwidth = AR.Width」で、矢印図形の変数値を書き換えます。

順番4は「Right>E And 反転している」ですので、232行目で「((AR.Left + AR.Width) > Cells(1, DstartCol + Dwidth).Left) And AR.HorizontalFlip = True」としています。
実施内容は「図形右端をEにし、図形の左端を元図形の右端にする(図6-16の⑫)」で、233~237行目を実行します。
まず233行目で反転を戻し、234行目の「AR.Width = Cells(1, DstartCol + Dwidth).Left - AR.Left」で領域の右端と元の図形の左端の差を図形の幅(Width)にします。現在の図形の左端は元の図形の右端のまま固定されているように見えますが、操作によってはズレる時がありますので235行目の「AR.Left = ARleft + ARwidth」で元の右端位置に戻しています。
最後に236~237行目で矢印図形の変数値を書き換えます。

順番5は「Left<S」ですので、238行目で「AR.Left < Cells(1, DstartCol).Left」としています。
実施内容は「図形の左端をSにし、長さは元の図形と同じ(図6-16の⑭⑮)」です。図形は位置の変更(この場合は、左端位置を領域の左端へ)をしても、サイズ(この場合、長さ・幅)は変わりませんので、図形のWidthプロパティの変更は不要に思えます。
しかし今回システムでは、このプロシージャの前処理として「ARcellFixプロシージャ」でセル位置にピッタリするように図形の補正をしています。例えば日程線領域内では列幅が同一だとしても、その外側の列幅が異なるとすると、領域をはみ出した図形はまず「領域の外の列幅に合わせて図形サイズを補正」した後(元の図形とサイズが変わってしまっている)に、このプロシージャで処理を行うことになります。
ですので、239行目の「AR.Width = ARwidth」で矢印図形の幅を元に戻しています。そして240行目の「AR.Left = Cells(1, DstartCol).Left」で図形左端を領域の左端に併せています。
最後に241~242行目で矢印図形の変数値を書き換えます。

順番6は「Right>E」ですので、243行目で「(AR.Left + AR.Width) > Cells(1, DstartCol + Dwidth).Left」としています。
実施内容は「図形の右端をEにし、長さは元の図形と同じ(図6-16の⑯⑰)」で、ほぼ順番6と同じです。
244行目の「AR.Width = ARwidth」で図形幅を元に戻し、245行目の「AR.Left = Cells(1, DstartCol + Dwidth).Left - ARwidth」で、図形の右端を領域の右端に併せています。246~247行目で矢印図形の変数値を書き換えます。

順番7は「Leftが移動 または Rightが移動」ですので、248行目で「AR.Left <> ARleft Or (AR.Left + AR.Width) <> (ARleft + ARwidth)」としています。
実施内容は「図形の変更を容認(図6-16の①③④⑤⑦⑨⑩⑪⑬)」ですが、図形がもし反転していた場合は元に戻しておかないと「次に反転した時に、反転プロパティが消え(AR.HorizontalFlip = False)てしまい、正しい判定が出来なく」なってしまいます。ですので、249行目の「If AR.HorizontalFlip = True Then AR.Flip msoFlipHorizontal」で、反転図形の場合に元に戻しています。
その他は容認しますので、250~251行目で矢印図形の変数値を書き換えます。

なお248行目までで「修正するべき図形は全て処理済み」ですので、248行目のIf文は「Else」という方法も考えられます。ただしその場合は、動いていない矢印図形(図6-16の『初期』のもの)も「このElseを通過する」ことになります。
今回システムはグリッド吸着で図形の動きに制限を与えていますが、それでも図形を微妙に動かすことが可能です。微妙に動かされた図形は「ARcellFix(図6-11)」プロシージャでセル単位に補正され、そのあとに「ARareaFix(図6-15の、このプロシージャ)」が必ず実行され、「Else」でAR.LeftとAR.Widthが同じ値で置き換えられることになります。
もし「ARcellFix」で修正された時に「微妙なズレが発生」してしまった場合は、Elseの場合は「ズレが正当化」されて、変数ARleft、及びARwidthがズレた値に置き換えられてしまいます。
このような「異常を少しでも取り込まない」ために、今回は「Else」にはせず、248行目のElseIf文を使うことにしました。

6-7-2.左矢印(ARtype=1)の処理

左矢印(完了日が領域の外にある)場合に、図形を移動・変形したときに「どのような形になるか」また「どのような形に収めるのか」をまとめたのが、図6-21です。両矢印との大きな違いは、図形の右端が動いても元に戻すことです。
左矢印図形の変形パターン
図6-21

両矢印の時と同様に「図形の変形方法」と「発見方法」を1つの表にし、図6-22の表を作成しました。そして、変更方法ごとに絞り込む式を立案しました。変形方法ごとにパターンを絞り込む式の作り方は、両矢印の時と同じです。
左矢印図形の変形方法と発見方法を合体した表
図6-22

その作られた式には、他の変形方法を使用している(例えば、変形方法Dの式に変形方法Cの結果を使っている)ものもあるため、図6-23のように実行する順序を考えて並べます。
左矢印図形の処理順番
図6-23

この順番でIf~ElseIf~文を組み立てていきます。
まず順番1は「図形が反転していて、図形の右端が領域の右端をオーバーしている」ですので、255行目で「AR.HorizontalFlip = True And AR.Left + AR.Width >= Cells(1, DstartCol + Dwidth).Left」としています。

式の不等号はType0~2も含め、他のIf文ではイコール無しの「>」を使っているのに、255行目だけは「イコール付き」にしています。これは左矢印図形を縮めて「領域の右端に幅ゼロにしよう」とした時に、図形の幅(Width)はゼロで且つ図形位置(Left)は領域右端ですので、「AR.Left + AR.Width = Cells(1, DstartCol + Dwidth).Left」となってしまい、イコール無しの不等号では255行目のIf文が不成立になります。
すると261行目(順番2)のIf文「AR.HorizontalFlip = True」で成立してしまうため、「元の状態に戻されて」しまいます。
原因は、図形を右方向に縮めてゼロにする時は、グリッド吸着の影響もあるため図形は反転した状態で極小になるためです。(なお、左方向に縮めてゼロにする時は反転しないで極小になるため、279行目のIf文にはイコールを付けていません。)

順番1の実施内容は「反転を戻し、領域右端で最小にする(図6-21の④)」です。
まず256行目の「AR.Flip msoFlipHorizontal」で反転を戻します。次に257行目の「AR.Width = 0」で図形幅をゼロにし、258行目で変数ARwidth値を更新しています。
最後に258行目の「AR.Left = Cells(1, DstartCol + Dwidth).Left」で、図形の左端を領域の右端に合わせ、変数ARleft値を259行目で更新します。

順番2は「図形が反転している」ですので、261行目は「AR.HorizontalFlip = True」としています。
順番2の実施内容は「反転を戻し、初期状態に戻す(図6-21の⑦⑧)」です。
まず262行目の「AR.Flip msoFlipHorizontal」で反転を戻します。次に263~264行目で、もとのWidth値・Left値をWidthプロパティ・Leftプロパティに設定することで「元の図形位置・サイズ」に戻しています。

順番3は「図形の右端が移動している」ですので、265行目は「(AR.Left + AR.Width) <> (ARleft + ARwidth)」としています。
順番3の実施内容は「初期状態に戻す(図6-21の⑤⑥⑨⑩⑪⑫⑬)」です。
266~267行目で、もとのWidth・Left値をWidth・Leftプロパティに設定することで「元の図形位置・サイズ」に戻しています。

順番4は「図形の左端が領域の左端をオーバーしている」ですので、268行目は「AR.Left < Cells(1, DstartCol).Left」としています。
順番4の実施内容は「図形の左端を領域の左端に合わせる(図6-21の②)」です。
まず269行目の「AR.Width = Cells(1, DstartCol + Dwidth).Left - Cells(1, DstartCol).Left」で、図形の幅を「領域の幅」に設定し、その値を270行目で変数ARwidthに代入します。
次に271行目の「AR.Left = Cells(1, DstartCol).Left」で左矢印図形の左端を領域左端に揃え、その値を272行目で変数ARleftに代入しています。

順番5は「図形の左端が移動している」ですので、273行目は「AR.Left <> ARleft」としました。
順番5の実施内容は「図形の変形を容認する(図6-21の①③)」ですので、274~275行目では変数ARwidth・ARleftに図形のWidthプロパティ値とLeftプロパティ値をそれぞれ代入します。

6-7-3.右矢印(ARtype=2)の処理

右矢印(開始日が領域の外にある)場合に、図形を移動・変形しようとしたときに「どのような形になるか」「どのような形に収めるのか」をまとめたのが、図6-24です。
右矢印図形の変形パターン
図6-24

図6-25は、「図形の変更方法」と「発見方法」を一覧にしたものです。そして変更方法ごとに絞り込む式を立案しました。
右矢印図形の変形方法と発見方法の合体表
図6-25

その作られた式の中には、他の変形方法の式を参照しているものがありますので、図6-26のように実行順序を考えて並べます。
右矢印図形の処理順番
図6-26

内容はARtype=1をちょうど反転させた まず順番1は「図形が反転していて、図形の左端が領域の左端をオーバーしている」ですので、279行目のIf文は「AR.HorizontalFlip = True And AR.Left < Cells(1, DstartCol).Left」としました。
順番1の実施内容は「反転を戻し、領域左端で最小にする(図6-24の④)」です。
まず280行目の「AR.Flip msoFlipHorizontal」で反転を戻します。次に281行目の「AR.Width = 0」で図形幅をゼロにし、その値を282行目で変数ARwidthに代入します。
最後に283行目の「AR.Left = Cells(1, DstartCol).Left」で図形左端を領域左端に合わせ、284行目でその値を変数ARleftに代入します。

順番2は「図形が反転している」ですので「AR.HorizontalFlip = True」とします。
順番2の実施内容は「反転を戻し、初期状態に戻す(図6-24の⑦⑧)」です。
286行目の「AR.Flip msoFlipHorizontal」で反転を戻し、287~288行目で元の図形のARwidth・ARleft値を新しい図形のWidthプロパティ・Leftプロパティにそれぞれ設定します。

順番3は「図形の左端が移動している」ですので「AR.Left <> ARleft」としています。
順番3の実施内容は「初期形状に戻す(図6-24の⑤⑥⑨⑩⑪⑫⑬)」です。
290~291行目で、元の図形のARwidth・ARleft値を新しい図形のWidthプロパティ・Leftプロパティにそれぞれ設定することで、初期状態の位置・サイズに戻しています。

順番4は「図形の右端が領域の右端をオーバーしている」ですので「AR.Left + AR.Width > Cells(1, DstartCol + Dwidth).Left」とします。
順番4の実施内容は「図形の右端を領域の右端にする(図6-24の②)」です。
293行目の「AR.Width = Cells(1, DstartCol + Dwidth).Left - ARleft」で、図形の幅(Width)を領域の全幅に指定します。なお、269行目のように「AR.Width = Cells(1, DstartCol + Dwidth).Left - Cells(1, DstartCol).Left」としても良いですが、「右矢印の左端は領域の左端から動かない」ので、右矢印の場合に限り「ARleft」を定数のように使用できます。
294行目では、変更された図形の幅値を変数ARwidthに代入しています。

なお、ここでは図形のLeftプロパティに値を設定(コードとしては、AR.Left = ARleft)していません。もしかしたら293行目の実行時に「わずかに図形のLeftがズレる」可能性もあります。しかし変数ARleftの値は初期のまま残っていますので、Do~Loopでもう一周回った時に図6-8の137行目「If AR.Left <> ARleft Or AR.Width <> ARwidth Then」で引っ掛かり、ARcellFixプロシージャの実行でセル単位に揃えてくれますので、ここでの指定は省略しました。

順番5は「図形の右端が移動している」ですので「(AR.Left + AR.Width) <> (ARleft + ARwidth)」としています。
順番5の実施内容は「変形形状を容認する(図6-24の①③)」ですので、296行目では変数ARwidthに図形のWidthプロパティ値を代入します。なお、図形のLeftプロパティに値を設定しないのは、順番4と同じ理由です。

6-8.矢印図形から開始日・完了日の書込み

矢印図形で日程の調整をしたのち、任意のセルを選択するとWorksheet_SelectionChangeイベントが発生し、図5-2のイベントプロシージャ内の15行目から図6-27の「Date_Fixプロシージャ」が呼び出されます。
  1. '========== ⇩(11) 開始日・完了日の書込み ============
  2. Public Sub Date_Fix()
  3.  Dim ARstartCol As Long     '←図形の左端の列位置
  4.  Dim ARendCol As Long      '←図形の右端の列位置
  5.  ARstartCol = AR.TopLeftCell.Column
  6.  ARendCol = AR.BottomRightCell.Column
  7.  Select Case ARtype
  8.   Case 0
  9.    If AR.Width = 0 Then
  10.     Cells(ARrow, Scol).Value = ""
  11.     Cells(ARrow, Ecol).Value = ""
  12.    Else
  13.     Cells(ARrow, Scol).Value = Cells(Drow, ARstartCol).Value
  14.     Cells(ARrow, Ecol).Value = Cells(Drow, ARendCol - 1).Value
  15.    End If
  16.   Case 1
  17.    If AR.Width = 0 Then
  18.     Cells(ARrow, Scol).Value = Cells(Drow, DstartCol + Dwidth - 1).Value + 1
  19.    Else
  20.     Cells(ARrow, Scol).Value = Cells(Drow, ARstartCol).Value
  21.    End If
  22.   Case 2
  23.    If AR.Width = 0 Then
  24.     Cells(ARrow, Ecol).Value = Cells(Drow, DstartCol).Value - 1
  25.    Else
  26.     Cells(ARrow, Ecol).Value = Cells(Drow, ARendCol - 1).Value
  27.    End If
  28.  End Select
  29.  AR.Delete
  30.  Set AR = Nothing
  31. End Sub
図6-27

このプロシージャ内も矢印図形の形(ARtype)で処理内容が異なりますので、312行目の「Select Case ARtype」で分岐させています。両矢印(ARtype = 0)の場合が314~320行目、左矢印(ARtype = 1)の場合が323~327行目、右矢印(ARtype = 2)の場合が330~334行目です。
なお、このプロシージャ内で使用される共通変数・定数を整理しておきます。
 ・ARrow :図形の行位置
 ・Scol  :開始日の列位置
 ・Ecol  :完了日の列位置
 ・Drow  :日付の行位置

まず309行目の「ARstartCol = AR.TopLeftCell.Column」、310行目の「ARendCol = AR.BottomRightCell.Column」で、矢印図形の左端・右端の「列位置」を取得します。
次に312行目の「Select Case ARtype」で、矢印図形のTypeごとに分岐させます。

「両矢印(ARtype = 0)」の場合、矢印図形の幅(Width)がゼロか否かで更に分岐します。
ゼロの場合は、今回システムでは「予定を削除する」ことを表しますので、315~316行目で「開始日」と「完了日」の日付を空欄にします。
ゼロで無い場合は、318行目の「Cells(ARrow, Scol).Value = Cells(Drow, ARstartCol).Value」で、「開始日」に図形の左端が指す日付を記入します。
また319行目の「Cells(ARrow, Ecol).Value = Cells(Drow, ARendCol - 1).Value」で、「完了日」に図形の右端(図形的にはARendColは1つ右側を指しますので、1つ左(-1)にズレたところ)の日付を記入します。

「左矢印(ARtype = 1)」の場合も、矢印図形の幅(Width)がゼロか否かで更に分岐します。
ゼロの場合は、今回システムでは「表示日付の最終日の翌日を開始日にする」ことを表しますので、324行目の「Cells(ARrow, Scol).Value = Cells(Drow, DstartCol + Dwidth - 1).Value + 1」で、「開始日」に「表示日付の最終日の次の日(+1)」を記入します。
ゼロで無い場合は、326行目の「Cells(ARrow, Scol).Value = Cells(Drow, ARstartCol).Value」で、「開始日」に図形の左端が指す日付を記入します。
左矢印では「完了日」は制御できませんので、操作しません。

「右矢印(ARtype = 2)」の場合も、矢印図形の幅(Width)がゼロか否かで更に分岐します。
ゼロの場合は、今回システムでは「表示日付の初日の前日を完了日にする」ことを表しますので、331行目の「Cells(ARrow, Ecol).Value = Cells(Drow, DstartCol).Value - 1」で、「完了日」に「表示日付の初日の前の日(-1)」を記入します。
ゼロで無い場合は、333行目の「Cells(ARrow, Ecol).Value = Cells(Drow, ARendCol - 1).Value」で、「完了日」に図形の右端(図形的にはARendColは1つ右側を指しますので、1つ左(-1)にズレたところ)が指す日付を記入します。
右矢印では「開始日」は制御できませんので、操作しません。

開始日・完了日を書き換えたら矢印図形は不要となりますので、338行目の「AR.Delete」で図形を削除し、339行目の「Set AR = Nothing」で「オブジェクトARを解除」します。ARを解除しないと、Deleteしてもオブジェクトが無くなったことにはならず、図6-8の「Do~Loopが回り続けます」し、図5-2で「図形も無いのにセルを選択すると、開始日・完了日を書き換えようとする(もちろんエラーが出ます)」不具合が発生します。

6-9.「矢印取消」ボタンが押された時の処理

ワークシート上の「矢印取消」ボタンをクリックした時に動作するプロシージャが図6-28です。
  1. '========== ⇩(12) .「矢印取消」ボタン ============
  2. Public Sub ESCstop()
  3.  If Not AR Is Nothing Then
  4.   AR.Delete
  5.   Set AR = Nothing
  6.  End If
  7. End Sub
図6-28

矢印図形が無い時にクリックしても、何も動作しないように346行目の「If Not AR Is Nothing Then」で仕訳けています。
図形が存在する時(Not AR Is Nothing がTrue)は、347行目の「AR.Delete」で矢印図形(オブジェクトAR)を削除し、348行目の「Set AR = Nothing」でオブジェクトを解除します。

6-10.図形グリッドのON-OFF

図6-5の98行目、図6-8の158行目・176行目から呼び出されるのが図6-29です。
引数として「GridSetting_Get」を受け取り、その引数が
Trueの時は「ユーザーのグリッド設定条件を保存し、矢印図形を操作し易いようにグリッド吸着ONに変更」することを意味し、
Falseの時は「矢印図形の表示が終わったので、保存したユーザーのグリッド条件に戻す」ことを意味します。
  1. '========== ⇩(13)  ============
  2. Public Sub GridChange(GridSetting_Get As Boolean)
  3.  Dim CurrentGridSet As Boolean     '←現状のグリッド吸着の状態
  4.  With Application.CommandBars.FindControl(ID:=549)
  5.   CurrentGridSet = .Control.State
  6.   Select Case GridSetting_Get
  7.    Case True
  8.     myGrid = CurrentGridSet
  9.     If myGrid = False Then
  10.      .Execute
  11.     End If
  12.    Case False
  13.     If myGrid = Not CurrentGridSet Then
  14.      .Execute
  15.     End If
  16.   End Select
  17.  End With
  18. End Sub
図6-29

図形のグリッド吸着は図6-30のように、図形を選択状態にしてからリボンの描画ツールの「書式」タブ→「配置」グループ→「配置」→「枠線に合わせる」で切り替えます。
左端のマークが選択状態(背景色が薄い灰色)がグリッドON、背景無し状態がグリッドOFFです。ONとOFFはトグルになっているのでクリックするたびに切り替わります。
グリッド吸着の設定
図6-30

このクリック操作をマクロ側から行うのが「Application.CommandBars.FindControl (ID:=549) .Execute」というコードです。現在の状態がONであればOFFになり、OFFであればONに切り替わります。
そして「現在のグリッド状態」を知るには「Application.CommandBars.FindControl (ID:=549) .Control.State」の値(Boolean型)で判断をします。値がTrueならON、値がFalseならOFFを表します。

ですので、このプロシージャ内では、358行目で「With Application.CommandBars.FindControl (ID:=549)」とし、「グリッド吸着の状態チェック」と「グリッド吸着をクリック」の組合せで、状態を切り替えていきます。なおユーザーのグリッド状態を保存しておくのは共通変数myGridです。

まず360行目の「CurrentGridSetting = .Control.State」で現状のグリッド状態を把握し、変数CurrentGridSettingに代入します。Control.Stateで取得する値は「グリッドON=True」「グリッドOFF=False」です。
ここで「ん?」と思われた方もいると思います。現状把握は「矢印図形を描画する前にのみ行うはず」なので「直接myGridに入れれば良い」はずですし、また元のユーザー設定に戻す時点では「矢印図形を操作している間は『グリッドON』」だから です。

しかし今回仕様では、矢印図形を操作している間でもグリッドのON-OFF操作は可能です。もし「描画ツール」が表示されていなくても、事前に「リボンのユーザー設定」でどこかに「グリッド吸着」をセットしておけば可能となります。
ですので一見無駄なコードに見えますが、360行目で再確認の意味で現在の状態を取得しています。

次に引数「GridSetting_Get」の値を使って362行目のSelect Case文で、動作を切り替えます。
True(ユーザーのグリッド設定条件を保存し、グリッド吸着設定をON)の場合は364~368行目を実行し、False(保存したユーザーのグリッド条件に戻す)の場合は371~373行目を実行します。

Trueの場合(ユーザー設定を保管し、グリッド吸着をONにする)は、まず364行目の「myGrid = CurrentGridSetting」で、共通変数myGridに現在のグリッド状態を保管します。
そして現状がFalse(グリッドOFF)の時(366行目)だけ、367行目の「.Execute」でグリッドONに切り替えます。現状が既にONであれば、切り替える必要はありません。

370行目のFalseの場合(ユーザー設定に戻す)は、「保存されているユーザー設定」と「現状のグリッド設定」の関係があるので、図6-31にまとめました。
ユーザー設定
(myGrid)
現状グリッド設定
(CurrentGridSet)
実行要否実行結果
TrueTrueTrue
False.Execute
FalseTrue.ExecuteFalse
False
図6-31

この表から、ユーザー設定(myGrid)と現状グリッド設定(CurrentGridSet)の値が「逆のもの」について「.Execute」を実行すれば良いことが分かります。ですので、371行目で「If myGrid = Not CurrentGridSet Then」とし、成立する場合のみ372行目の「.Execute」でグリッド実行することにしました。

7.最後に

大袈裟に言えば今回システムは「図形を使ってセル値を制御する」というものですが、図形の位置・サイズは結構扱いにくく、面倒なプログラムになってしまいました。
もう少し単純に「領域を外れたか」だけを監視し、「領域を外れた図形は元の状態に戻す」というような仕様でも受け入れられるのかもしれません。

また、今回の図形の仕訳けだけでは充分では無く、おかしな動きをする部分が残ってしまいました。
例えば「左矢印」の図形を領域の右端に幅ゼロに縮め(=表示日付の次週初日を開始日にする)ます。次にその幅ゼロとなった図形を「反転させて」復活させる(=表示日付内に開始日を戻す)操作をすると、幅ゼロの図形に戻ってしまいます。
ここでポイントになっているのは、図形幅ゼロの状態から引き延ばすときに「反転させないように延ばす」か、または「反転させて延ばす」かです。
(なお、図形幅ゼロの図形に横方向からそっとマウスを近づけ、マウスの形状が「十字」から「4方向矢印」になり、次に「左右矢印」になった時に図形をクリックして「マウスが近づいてきた方向に伸ばせば反転せずに変形」が出来るようです)

原因は「図形を幅ゼロから反転させて伸ばす」と「図6-21には存在しない形」になってしまうため、プログラムとして判断を誤ってしまうためです。これは、図形をセルサイズに合わせる「ARcellFixプロシージャ」の副作用(中途半端な図形幅に出来ない)とも言えるのですが、これが無いとまたパターンが増えてしまうというやっかいなものです。
不具合解消には、幅ゼロの状態から図形を変形させた時のパターンを洗い出し、それぞれに「どのように形状修正をさせるか」を考える必要があります。
しかし通常のパターンの分けだけで疲れ切ってしまったので、今回は省略しています。また機会があったら再トライします。
期せずして図形幅がゼロになってしまった時には、「矢印取消」ボタンやESCキーなどで「一旦キャンセル」してから再実行するようにして下さい。

また、片矢印図形が表示された状態で、その範囲内の列幅を変更すると、固定側にズレが発生してしまします。原因は、「固定側が移動した」と判断し、図形の幅を元に戻そうとするロジックだからです。
更に悪いことに、その後矢印側を動かしても「固定側が移動している(順番3)」という判断が「矢印側が移動している(順番5)」の判断よりも前にあるために、動かなくなる現象になってしまいます。

対策として下記のような手法が考えられますが、内部で使うアプリであれば「注意しながら使ってもらう」でも良いかと思います。
1)常に領域の左端・右端をチェックする
2)左端・右端の位置をLeft・Widthと併せて列位置も記憶しておく
3)GridChange内に「ActiveWindow.DisplayHeadings = False/True」を仕込み、「図形描画時は行列番号を非表示」にする
4)シート保護で「列の書式設定」をロックする


マウス操作で日程の開始・完了を設定できるタスク表(it-053.xlsm)

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