エクセルシート内にオブジェクトとして違うシートを埋め込んで体裁を整えるやり方があります。
赤枠内をクリックすると違うエクセルシートが出現します。
埋め込んだエクセルに日付があり、これが「=now()」関数で、この埋め込みシートを開かないと日付の更新できません。
ちまちま、このエクセルを開くたびに埋め込みシートを開かずとも、何とか自動化できないか？と言う事です。
以下のコードを記述するとなんでも良いのでイベントをフックとして開いて閉じる動作ができました。
イベントに応じて自動的に開いて閉じるため「=now()」関数が更新されて現在の日時へと変更されます。
ActiveSheet.Shapes.Range(Array("object3")).Select
Windows("schedule.xlsm").Visible = True
Selection.Verb Verb:=xlPrimary
ActiveWorkbook.Closeちょっと拡張してブックを最初に開いたときに「読み取り専用：はい」か「編集：いいえ」か？選択させて、開かせて、「編集」で開いた時のみオブジェクトを開いて閉じる設定とします。
設定をします。
「名前を付けて保存」の時に「ツール」から「全般オプション」を選択します。
ここでチェックを入れてブックを保存します。
開いた時に選択画面となります。
複数人でブックを使用する場合、先に開いた人に「編集」が与えられて、その次に同じブックを開いた人は「読み取り」になってしまうので、見るだけの人は「読み取り：はい」で見てもらう設定です。
２パターンを用意しました。
設定パターンその１
上記で「いいえ」を選択した人のみ、オブジェクトの開閉をする設定です。
「ThisWorkbook」に配置します。
Private Sub Workbook_Open()
Dim wb As Workbook
Dim readOnlyFlg
Set wb = ActiveWorkbook
readOnlyFlg = wb.ReadOnly
If readOnlyFlg = False Then
ActiveSheet.Shapes.Range(Array("object3")).Select
Windows("schedule.xlsm").Visible = True
Selection.Verb Verb:=xlPrimary
ActiveWorkbook.Close
End If
'リビジョンアップ
If ActiveWorkbook.Saved = False Then
Worksheets("Sheet1").Cells(4, 1) = Worksheets("Sheet1").Cells(4, 1) + 1
End If
End Sub設定パターンその２
上記で「いいえ」を選択した人のみ、指定範囲で初回変更があった時のみにオブジェクトを開閉します。
セルを更新するたびにオブジェクトの開閉をしていたのではウザったいので初回のみ開閉します。
初期設定タブ（シート）を用意して指定範囲に変更があった場合に始めての更新のみ初期設定タブの指定セルに数値の「１」を書き込みます。
編集が終了してブックを閉じる時に数値を「０」に元に戻して次回、ブックを開く時に開閉できるようにしておきます。
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B3:AG17")) Is Nothing Then
Exit Sub
Else
If Worksheets("Sheet2").Range("F4") = 0 Then
ActiveSheet.Shapes.Range(Array("object3")).Select
Windows("schedule.xlsm").Visible = True
Selection.Verb Verb:=xlPrimary
ActiveWorkbook.Close
End If
Worksheets("Sheet2").Range("F4").Value = 1
End If
'リビジョンアップ
If ActiveWorkbook.Saved = False Then
Worksheets("Sheet1").Cells(4, 1) = Worksheets("Sheet1").Cells(4, 1) + 1
End If
End Subブックを閉じる際に記述した値をデフォルトの「０」にします。
「ThisWorkbook」に以下を記述します。
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Worksheets("Sheet2").Range("F4").Value = 0
End Sub