Excelで作成されたよくある一覧表形式のファイル
No | 項目 | 内容 |
1 | AAAAAAAAA | aaaaaaaaaaaaaaaaaaa |
2 | BBBBBBBBB | bbbbbbbbbbbbbb |
3 | CCCCCCCCCC | ccccccccccc |
4 | DDDDDDDDD | dddddddddddddddddddddd |
5 | EEEEEEE | eeee |
6 | ||
7 | ||
8 |
このファイル自身を、バックアップのために、例えば以下のルール名で保存したい
1 2 3 |
YYYYMMDDNNNN_ファイル名 YYYYMMDD:日付 NNNN:一覧表のインデックスNo |
そのような場合に使えるVBAコード
ポイントは、ThisWorkbook.SaveCopyAs を使うこと
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 |
Option Explicit Sub CopyMySelf() Dim Path As String Dim Ws As Worksheet Set Ws = ThisWorkbook.Sheets("Sheet1") Path = GetSaveFilePath Path = Path & GetTargetDay Path = Path & GetLastLastRowIndex(Ws, 3) '最終行からNoを検索 Path = Path & GetFileName Dim InformationPrompt As String InformationPrompt = InformationPrompt & "ツールが自動生成したファイル名です。" & vbLf InformationPrompt = InformationPrompt & "YYYYMMDD:" & GetTargetDay & vbLf InformationPrompt = InformationPrompt & vbLf InformationPrompt = InformationPrompt & "このファイル名で保存しますか?" & vbLf Path = InputBox(InformationPrompt, "出力先ファイルパス", Path) ThisWorkbook.SaveCopyAs Path End Sub Function GetLastLastRowIndex(ByVal Ws As Worksheet, ByVal CheckColmun As Long) Dim LastRowIndex As Long LastRowIndex = Ws.Cells(Rows.Count, CheckColmun).End(xlUp).Row GetLastLastRowIndex = Format(LastRowIndex, "0000") End Function Function GetTargetDay() GetTargetDay = Format(Now, "YYYYMMDD") End Function Function GetFileName() GetFileName = "_" & ThisWorkbook.Name End Function Function GetSaveFilePath() GetSaveFilePath = ThisWorkbook.Path & "\Tmp\" End Function |
コメント