エクセル小僧：ファイル保存時に、現在の日時を更新日時として、特定のセルに代入する(改2） [コンピューター]
http://cheese999.blog.so-net.ne.jp/2016-02-06-1
で紹介したマクロを少し改良しましたので紹介します。
![[猫]](https://blog.ss-blog.jp/_images_e/101.gif)
【マクロの目的】
エクセルファイルの更新日時をエクセル上で見れるようにする。
エクセルからエクスプローラに切り替えるのも面倒と思ったので。
【2016/2/6の記事のマクロからの変更点】
・日付2_1マクロと日付2マクロの機能分割と引数を変更。
日付2_1マクロで現在アクティブなシート、セル、現在のスクロール位置、更新日時を代入するシート、セルを引数にして日付2マクロをコールするように変更。
・日付2マクロの引数のうち、シート、セルをString型から、Worksheet型、Range型（オブジェクト変数）に変更。
【動作】
１．ファイル保存をトリガとして、マクロを自動的に起動する。
２．あらかじめマクロ内で指定したシートの指定したセルに更新日時を代入する。
３．マクロ起動前のシートに戻り、スクロール位置も元に戻す。
４．（追加）ファイルを再び開いたとき、現在の日時とファイルの更新日時をメッセージボックスに表示
【マクロ構成】
４つのマクロで構成。
[ThisWorkbookに記述するマクロ]
１．Workbook_BeforeSave
ファイル保存をトリガとして、自動的に起動されるマクロ。
日付2_1マクロをコール。
２．Workbook_Open
ファイルオープンをトリガとして、自動的に起動されるマクロ。
現在の日時とファイルの更新日時をメッセージボックスに表示
[標準モジュールに記述するマクロ]
３．日付2_1
現在アクティブなシート、セル、現在のスクロール位置、更新日時を代入するシート、セルを引数にして日付2マクロをコール
４．日付2
更新日時を指定されたシートの指定されたセルに代入。その後、マクロ起動前のシート、スクロール位置に戻る。
【マクロコード】
１．ThisWorkbookに記述しているマクロ
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
' 【機能】保存時にJ1セルの更新日の日付、時刻を更新
' 日付2_1プロシージャをコール
日付2_1
End Sub
Private Sub Workbook_Open()
' Workbookを開いたときの処理
' 現在の時刻、更新日を表示
' 配列を定義
Dim str1(2) As String
Dim mySheet As Worksheet
' 現在の時刻の文字列を生成
str1(0) = Format(Now(), "yyyy/mm/dd(aaa) hh:mm:ss")
' "現在："と改行を連結
' Tab[Chr(9)]で：の位置を揃える
str1(1) = "現在" & Chr(9) & "：" & str1(0) & vbCrLf
' 更新日(J1セル)を連結
Set mySheet = ActiveSheet
Worksheets("current").Activate
str1(1) = str1(1) & "更新日" & Chr(9) & "：" & Format(Range("J1"), "yyyy/mm/dd(aaa) hh:mm:ss")
' メッセージボックスに表示
MsgBox str1(1)
mySheet.Activate
End Sub
２．標準モジュールに記述しているマクロ
Sub 日付2_1()
' 【機能】currentシートのJ1セルの更新日の日付、時刻を更新
' 【変数】
Dim mySheet1(1) As Worksheet
' mySheet1(0) : 更新日を代入するシート
' mySheet1(1) : ActiveSheet
Dim myRange1(1) As Range
' myRange1(0) : 更新日を代入するセル
' myRange1(1) : ActiveWindow.ActiveCell
Dim row1 As Long ' 行
Dim col1 As Long ' 列
' 【実行コード】
' 現在アクティブなシート、セル
Set mySheet1(1) = ActiveSheet ' ActiveSheetを退避
Set myRange1(1) = ActiveWindow.ActiveCell ' 現在のアクティブセルを退避
' 現在のスクロール位置を記憶
row1 = ActiveWindow.ScrollRow ' スクロール位置(行)
col1 = ActiveWindow.ScrollColumn ' スクロール位置(列)
' 画面更新停止
Application.ScreenUpdating = False
' 更新するシート、セル
Set mySheet1(0) = Worksheets("current") ' シートをセット
mySheet1(0).Activate ' シートをアクティブ化
Set myRange1(0) = Range("J1")
' 日付2プロシージャをコール
Call 日付2(myRange1, mySheet1, row1, col1)
' 画面更新再開
Application.ScreenUpdating = True
End Sub
Sub 日付2(ByRef myRange1() As Range, ByRef mySheet1() As Worksheet, ByRef row1 As Long, ByRef col1 As Long)
' 【機能】myRange1で指定されるセルの更新日の日付、時刻を更新
' 【引数】
' myRange1(0) : 更新日を代入するセル
' myRange1(1) : ActiveWindow.ActiveCell
' mySheet1(0) : 更新日を代入するシート
' mySheet1(1) : ActiveSheet
' row1 : スクロール位置(行)
' col1 : As Long ' スクロール位置(列)
' 【変数】
Dim str1(2) As String
Dim sheetName1 As String ' シート名
Dim QA1 As Integer ' 質問
' 【実行コード】
Application.ScreenUpdating = False ' 画面更新停止
' 現在のスクロール位置を記憶
' row1 = ActiveWindow.ScrollRow ' スクロール位置(行)
' col1 = ActiveWindow.ScrollColumn ' スクロール位置(列)
' sheetName1 = ActiveSheet.Name ' 現在のアクティブシート名
' 更新日の日付、時刻の文字列を生成
str1(0) = Format(Now(), "yyyy/mm/dd(aaa) hh:mm:ss")
' myRange1(0)セルの更新日の日付、時刻を更新
mySheet1(0).Activate ' シートをアクティブ化
myRange1(0).Value = Now()
' myRange1(0)セルを選択してスクロール
Application.Goto myRange1(0), True
' 更新日の更新結果を表示する文字列の作成
str1(1) = "更新日：" & str1(0) & vbCrLf
str1(1) = str1(1) & mySheet1(0).Name & "シートの"
str1(1) = str1(1) & myRange1(0).Address(RowAbsolute:=False, ColumnAbsolute:=False)
str1(1) = str1(1) & "セルを更新しました。" & vbCrLf
str1(1) = str1(1) & "スクロール位置を戻す(Y) or A1セルを左上(N) ?"
Application.ScreenUpdating = True ' 画面更新再開
QA1 = MsgBox(str1(1), vbYesNoCancel + vbDefaultButton1, "スクロール位置の確認")
Application.ScreenUpdating = False ' 画面更新停止
If QA1 = vbYes Or QA1 = vbNo Then
' アクティブシートを戻す
mySheet1(1).Activate
' アクティブセルを戻す
myRange1(1).Activate
End If
If QA1 = vbYes Then
' スクロール位置を戻す(Y)
ActiveWindow.ScrollRow = row1 ' スクロール位置(行)
ActiveWindow.ScrollColumn = col1 ' スクロール位置(列)
ElseIf QA1 = vbNo Then
' A1セルが左上になるようにスクロール(N)
ActiveWindow.ScrollRow = 1 ' スクロール位置(行)
ActiveWindow.ScrollColumn = 1 ' スクロール位置(列)
ElseIf QA1 = vbCancel Then
' 何もしない
End If
Application.ScreenUpdating = True ' 画面更新再開
End Sub
【移植時に変更する箇所】
マクロを他のエクセルファイルに移植する際、次の箇所を変更して下さい。
[ThisWorkbookに記述しているマクロ]
１．Workbook_Openマクロ
Worksheets("current").Activate
str1(1) = str1(1) & "更新日" & Chr(9) & "：" & Format(Range("J1"), "yyyy/mm/dd(aaa) hh:mm:ss")
・"current"を、更新日時を代入するセルのシート名で置き換えます。
・"J1"を、更新日時を代入するセルのアドレスでで置き換えます。
[標準モジュールに記述しているマクロ]
２．日付2_1マクロ
' 更新するシート、セル
Set mySheet1(0) = Worksheets("current") ' シートをセット
mySheet1(0).Activate ' シートをアクティブ化
Set myRange1(0) = Range("J1")
・"current"を、更新日時を代入するセルのシート名で置き換えます。
・"J1"を、更新日時を代入するセルのアドレスでで置き換えます。
【気が付いたこと】
Range型オブジェクト変数にセル位置をセットするとき、アクティブシートを合わせておかないと、うまく動かないみたいです。
それで、更新日時を代入するcurrentシートのJ1セルをセットするのに、次のコードを記述しています。
' 更新するシート、セル
Set mySheet1(0) = Worksheets("current") ' シートをセット
mySheet1(0).Activate ' シートをアクティブ化
Set myRange1(0) = Range("J1")
で紹介したマクロを少し改良しましたので紹介します。
【マクロの目的】
エクセルファイルの更新日時をエクセル上で見れるようにする。
エクセルからエクスプローラに切り替えるのも面倒と思ったので。
【2016/2/6の記事のマクロからの変更点】
・日付2_1マクロと日付2マクロの機能分割と引数を変更。
日付2_1マクロで現在アクティブなシート、セル、現在のスクロール位置、更新日時を代入するシート、セルを引数にして日付2マクロをコールするように変更。
・日付2マクロの引数のうち、シート、セルをString型から、Worksheet型、Range型（オブジェクト変数）に変更。
【動作】
１．ファイル保存をトリガとして、マクロを自動的に起動する。
２．あらかじめマクロ内で指定したシートの指定したセルに更新日時を代入する。
３．マクロ起動前のシートに戻り、スクロール位置も元に戻す。
４．（追加）ファイルを再び開いたとき、現在の日時とファイルの更新日時をメッセージボックスに表示
【マクロ構成】
４つのマクロで構成。
[ThisWorkbookに記述するマクロ]
１．Workbook_BeforeSave
ファイル保存をトリガとして、自動的に起動されるマクロ。
日付2_1マクロをコール。
２．Workbook_Open
ファイルオープンをトリガとして、自動的に起動されるマクロ。
現在の日時とファイルの更新日時をメッセージボックスに表示
[標準モジュールに記述するマクロ]
３．日付2_1
現在アクティブなシート、セル、現在のスクロール位置、更新日時を代入するシート、セルを引数にして日付2マクロをコール
４．日付2
更新日時を指定されたシートの指定されたセルに代入。その後、マクロ起動前のシート、スクロール位置に戻る。
【マクロコード】
１．ThisWorkbookに記述しているマクロ
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
' 【機能】保存時にJ1セルの更新日の日付、時刻を更新
' 日付2_1プロシージャをコール
日付2_1
End Sub
Private Sub Workbook_Open()
' Workbookを開いたときの処理
' 現在の時刻、更新日を表示
' 配列を定義
Dim str1(2) As String
Dim mySheet As Worksheet
' 現在の時刻の文字列を生成
str1(0) = Format(Now(), "yyyy/mm/dd(aaa) hh:mm:ss")
' "現在："と改行を連結
' Tab[Chr(9)]で：の位置を揃える
str1(1) = "現在" & Chr(9) & "：" & str1(0) & vbCrLf
' 更新日(J1セル)を連結
Set mySheet = ActiveSheet
Worksheets("current").Activate
str1(1) = str1(1) & "更新日" & Chr(9) & "：" & Format(Range("J1"), "yyyy/mm/dd(aaa) hh:mm:ss")
' メッセージボックスに表示
MsgBox str1(1)
mySheet.Activate
End Sub
２．標準モジュールに記述しているマクロ
Sub 日付2_1()
' 【機能】currentシートのJ1セルの更新日の日付、時刻を更新
' 【変数】
Dim mySheet1(1) As Worksheet
' mySheet1(0) : 更新日を代入するシート
' mySheet1(1) : ActiveSheet
Dim myRange1(1) As Range
' myRange1(0) : 更新日を代入するセル
' myRange1(1) : ActiveWindow.ActiveCell
Dim row1 As Long ' 行
Dim col1 As Long ' 列
' 【実行コード】
' 現在アクティブなシート、セル
Set mySheet1(1) = ActiveSheet ' ActiveSheetを退避
Set myRange1(1) = ActiveWindow.ActiveCell ' 現在のアクティブセルを退避
' 現在のスクロール位置を記憶
row1 = ActiveWindow.ScrollRow ' スクロール位置(行)
col1 = ActiveWindow.ScrollColumn ' スクロール位置(列)
' 画面更新停止
Application.ScreenUpdating = False
' 更新するシート、セル
Set mySheet1(0) = Worksheets("current") ' シートをセット
mySheet1(0).Activate ' シートをアクティブ化
Set myRange1(0) = Range("J1")
' 日付2プロシージャをコール
Call 日付2(myRange1, mySheet1, row1, col1)
' 画面更新再開
Application.ScreenUpdating = True
End Sub
Sub 日付2(ByRef myRange1() As Range, ByRef mySheet1() As Worksheet, ByRef row1 As Long, ByRef col1 As Long)
' 【機能】myRange1で指定されるセルの更新日の日付、時刻を更新
' 【引数】
' myRange1(0) : 更新日を代入するセル
' myRange1(1) : ActiveWindow.ActiveCell
' mySheet1(0) : 更新日を代入するシート
' mySheet1(1) : ActiveSheet
' row1 : スクロール位置(行)
' col1 : As Long ' スクロール位置(列)
' 【変数】
Dim str1(2) As String
Dim sheetName1 As String ' シート名
Dim QA1 As Integer ' 質問
' 【実行コード】
Application.ScreenUpdating = False ' 画面更新停止
' 現在のスクロール位置を記憶
' row1 = ActiveWindow.ScrollRow ' スクロール位置(行)
' col1 = ActiveWindow.ScrollColumn ' スクロール位置(列)
' sheetName1 = ActiveSheet.Name ' 現在のアクティブシート名
' 更新日の日付、時刻の文字列を生成
str1(0) = Format(Now(), "yyyy/mm/dd(aaa) hh:mm:ss")
' myRange1(0)セルの更新日の日付、時刻を更新
mySheet1(0).Activate ' シートをアクティブ化
myRange1(0).Value = Now()
' myRange1(0)セルを選択してスクロール
Application.Goto myRange1(0), True
' 更新日の更新結果を表示する文字列の作成
str1(1) = "更新日：" & str1(0) & vbCrLf
str1(1) = str1(1) & mySheet1(0).Name & "シートの"
str1(1) = str1(1) & myRange1(0).Address(RowAbsolute:=False, ColumnAbsolute:=False)
str1(1) = str1(1) & "セルを更新しました。" & vbCrLf
str1(1) = str1(1) & "スクロール位置を戻す(Y) or A1セルを左上(N) ?"
Application.ScreenUpdating = True ' 画面更新再開
QA1 = MsgBox(str1(1), vbYesNoCancel + vbDefaultButton1, "スクロール位置の確認")
Application.ScreenUpdating = False ' 画面更新停止
If QA1 = vbYes Or QA1 = vbNo Then
' アクティブシートを戻す
mySheet1(1).Activate
' アクティブセルを戻す
myRange1(1).Activate
End If
If QA1 = vbYes Then
' スクロール位置を戻す(Y)
ActiveWindow.ScrollRow = row1 ' スクロール位置(行)
ActiveWindow.ScrollColumn = col1 ' スクロール位置(列)
ElseIf QA1 = vbNo Then
' A1セルが左上になるようにスクロール(N)
ActiveWindow.ScrollRow = 1 ' スクロール位置(行)
ActiveWindow.ScrollColumn = 1 ' スクロール位置(列)
ElseIf QA1 = vbCancel Then
' 何もしない
End If
Application.ScreenUpdating = True ' 画面更新再開
End Sub
【移植時に変更する箇所】
マクロを他のエクセルファイルに移植する際、次の箇所を変更して下さい。
[ThisWorkbookに記述しているマクロ]
１．Workbook_Openマクロ
Worksheets("current").Activate
str1(1) = str1(1) & "更新日" & Chr(9) & "：" & Format(Range("J1"), "yyyy/mm/dd(aaa) hh:mm:ss")
・"current"を、更新日時を代入するセルのシート名で置き換えます。
・"J1"を、更新日時を代入するセルのアドレスでで置き換えます。
[標準モジュールに記述しているマクロ]
２．日付2_1マクロ
' 更新するシート、セル
Set mySheet1(0) = Worksheets("current") ' シートをセット
mySheet1(0).Activate ' シートをアクティブ化
Set myRange1(0) = Range("J1")
・"current"を、更新日時を代入するセルのシート名で置き換えます。
・"J1"を、更新日時を代入するセルのアドレスでで置き換えます。
【気が付いたこと】
Range型オブジェクト変数にセル位置をセットするとき、アクティブシートを合わせておかないと、うまく動かないみたいです。
それで、更新日時を代入するcurrentシートのJ1セルをセットするのに、次のコードを記述しています。
' 更新するシート、セル
Set mySheet1(0) = Worksheets("current") ' シートをセット
mySheet1(0).Activate ' シートをアクティブ化
Set myRange1(0) = Range("J1")
ヤバイぜ! ありがとうございます[__猫]
by cheese999 (2016-02-18 05:16)
解説を追記しました。
by cheese999 (2016-02-18 05:17)
【移植時に変更する箇所】を追記しました。
by cheese999 (2016-02-23 20:53)