Excelで作成されたよくある一覧表形式のファイル
| No | 項目 | 内容 |
| 1 | AAAAAAAAA | aaaaaaaaaaaaaaaaaaa |
| 2 | BBBBBBBBB | bbbbbbbbbbbbbb |
| 3 | CCCCCCCCCC | ccccccccccc |
| 4 | DDDDDDDDD | dddddddddddddddddddddd |
| 5 | EEEEEEE | eeee |
| 6 | ||
| 7 | ||
| 8 |
このファイル自身を、バックアップのために、例えば以下のルール名で保存したい
YYYYMMDDNNNN_ファイル名 YYYYMMDD：日付 NNNN：一覧表のインデックスNo
そのような場合に使えるVBAコード
ポイントは、ThisWorkbook.SaveCopyAs を使うこと
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
コメント