エクセル小僧：ファイル保存時に、現在の日時を更新日時として、特定のセルに代入する

エクセルでファイル保存時に、現在の日時を更新日時として、特定のセルに代入するマクロを作成しました。



エクスプローラで更新日時を見れば済む話なのですが、エクセルからエクスプローラに
切り替えるのも面倒と思い、作ってみました。

【動作】
１．ファイル保存をトリガとして、マクロを自動的に起動する。
２．あらかじめマクロ内で指定したシートの指定したセルに更新日時を代入する。
３．マクロ起動前のシートに戻り、スクロール位置も元に戻す。

【マクロ構成】
汎用性を持たせるため、３つのマクロに分けました。
１．Workbook_BeforeSave：ファイル保存をトリガとして、自動的に起動されるマクロ。ThisWorkbookにマクロを記述。
　　日付2_1マクロをコール。
２．日付2_1：更新日時を代入するシート、セル、現在のアクティブセルを引数として、日付2マクロをコール。標準モジュールにマクロを記述。
３．日付2：更新日時を指定されたシートの指定されたセルに代入。その後、マクロ起動前のシート、スクロール位置に戻る。標準モジュールにマクロを記述。

【マクロコード】
１．Workbook_BeforeSave

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 ' 【機能】保存時にJ1セルの更新日の日付、時刻を更新
 ' 日付2_1プロシージャをコール
 日付2_1
End Sub

２．日付2_1

Sub 日付2_1()
 ' 【機能】currentシートのJ1セルの更新日の日付、時刻を更新
 ' 【変数】
 Dim myRange1 As String, myRange2 As String, mySheet1 As String
 myRange1 = Range("J1").Address ' 更新日を代入するセル
 myRange2 = ActiveWindow.ActiveCell.Address ' 現在のアクティブセル
 mySheet1 = "current"
 ' 日付2プロシージャをコール
 Call 日付2(myRange1, myRange2, mySheet1)
End Sub

※更新日時を代入するセルを変更するときは、上記myRange1 =の行の「J1」の部分を変更して下さい。
※更新日時を代入するシートを変更するときは、上記mySheet1 = の行の「current」の部分を変更して下さい。

３．日付2

Sub 日付2(ByVal myRange1 As String, ByVal myRange2 As String, ByVal mySheet1 As String)
 ' 【機能】myRange1で指定されるセルの更新日の日付、時刻を更新
 ' 【引数】
 ' myRange1 : 更新日を代入するセルのRange
 ' myRange2 : プロシージャ実行前のアクティブセルのRange
 ' mySheet1 : 更新日を代入するセルのシート名
 ' 【変数】
 Dim str1(2) As String
 Dim row1 As Long ' 行
 Dim col1 As Long ' 列
 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セルの更新日の日付、時刻を更新
 Worksheets(mySheet1).Range(myRange1).Value = Now()
 ' myRange1セルを選択してスクロール
 Application.Goto Worksheets(mySheet1).Range(myRange1), True
 ' 更新日の更新結果を表示する文字列の作成
 str1(1) = "更新日：" & str1(0) & vbCrLf
 str1(1) = str1(1) & mySheet1 & "シートの"
 str1(1) = str1(1) & Range(myRange1).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
  ' アクティブシートを戻す
  Worksheets(sheetName1).Activate
  ' アクティブセルを戻す
  Range(myRange2).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

【更新日のフォーマット】
「更新日：2016/01/31(日) 21:03:00」とします。

(1)ワークシートの更新日を表示するセルを選択して、セルの書式設定(Ctrl+1)を開きます。上記のマクロの場合、currentシートのJ1セルの書式設定(Ctrl+1)を開きます。
(2)表示形式タブで、分類：ユーザー定義を選択し、種類(T):の欄に「"更新日："yyyy/mm/dd(aaa) hh:mm:ss」と入力します。

【PS?!】
引数を配列で渡す方法がいまいち分からなくて。。。
分かったら、新記事にします。

タグ：VBA 更新日時 エクセル

コメント 1

ヤバイぜ!　ありがとうございます[__猫]
by cheese999 (2016-02-07 06:50)