'***************************************************************************************************
' Window垂直同期サンプル(同一シート) ThisWorkbook(Class)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev 変更履歴内容------------------------------------------------------------------------>
'03/08/02(1.00)新規作成
'03/11/16(1.01)初回修正
'20/02/23(1.10)*.xlsm化、他
'***************************************************************************************************
Option Explicit
'***************************************************************************************************
' ■■■ ワークブックイベント ■■■
'***************************************************************************************************
'* 処理名 :Workbook_Open
'* 機能 :ブック起動時自動実行
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年08月02日
'* 作成者 :井上 治
'* 更新日 :2020年02月23日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub Workbook_Open()
'-----------------------------------------------------------------------------------------------
Dim objWbk As Workbook ' 本ブック
Set objWbk = ThisWorkbook
Application.ScreenUpdating = False
' 本ブックのウィンドウが1つだけだったら新しいウィンドウを開く
If objWbk.Windows.Count <= 1 Then
ActiveWindow.NewWindow
End If
' ウィンドウを上下に並べ、縦方向のみ同期させる
Windows.Arrange ArrangeStyle:=xlArrangeStyleHorizontal, _
ActiveWorkbook:=True, _
SyncHorizontal:=False, _
SyncVertical:=True
Application.ScreenUpdating = True
End Sub
'
''***************************************************************************************************
''* 処理名 :Workbook_BeforeClose
''* 機能 :ブック閉鎖時自動実行
''---------------------------------------------------------------------------------------------------
''* 返り値 :(なし)
''* 引数 :Arg1 = Cancel(Boolean) ※Ref参照
''---------------------------------------------------------------------------------------------------
''* 作成日 :2003年08月02日
''* 作成者 :井上 治
''* 更新日 :2020年02月23日
''* 更新者 :井上 治
''* 機能説明:
''* 注意事項:
''***************************************************************************************************
'Private Sub Workbook_BeforeClose(Cancel As Boolean)
' '-----------------------------------------------------------------------------------------------
' Dim objWbk As Workbook ' 本ブック
' Set objWbk = ThisWorkbook
' Application.ScreenUpdating = False
' objWbk.Activate
' ' ウィンドウの同期を元に戻す
' Windows.Arrange ArrangeStyle:=xlArrangeStyleCascade, _
' ActiveWorkbook:=True, _
' SyncHorizontal:=False, _
' SyncVertical:=False
' ' 本ブックのウィンドウが複数だったら1つだけにする
' Do While objWbk.Windows.Count > 1
' ActiveWindow.Close False
' Loop
' Application.ScreenUpdating = True
' ' 本ブックを保存済みにする
' objWbk.Saved = True
'End Sub
'----------------------------------------<< End of Source >>----------------------------------------
このようになっています。