私は、サブルーチンも置かずに、一本で書いてしまったので、本当に汚いコードで自信がないけれど、1つの例として出しておきますね。これは、できれば、Personal.xls の標準モジュールで、ツールボタン登録がよいのではないかなって思いました。
Sub SaveWithTimeStamp()
Dim fName As String
Dim dFilePath As String
Dim myPath As String
Dim ans As Integer, rtn As String
dFilePath = Application.DefaultFilePath & "\"
fName = Format$(Date, "yymmdd")
myPath = dFilePath & fName & ".xls"
If Dir(myPath) = "" Then
ActiveWorkbook.SaveAs fName
Else
ans = MsgBox(fName & " と同名のファイルがすでにあります." & Chr(13) & _
"上書きしますか?", vbYesNoCancel)
If ans = vbYes Then
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs myPath
Application.DisplayAlerts = True
ElseIf ans = vbNo Then
fName = Application.InputBox("名前を変更してください." & Chr(13) _
& fName & ".xls", , fName, , , , , 2)
If rtn <> "False" Then
If InStr(fName, ".xls") = 0 Then fName = fName & ".xls"
myPath = dFilePath & fName
If Dir(myPath) = "" Then
ActiveWorkbook.SaveAs myPath
Else
MsgBox fName & "が、同じフォルダにありますので、1度フォルダを調べてください.", 64
Exit Sub
End If
Else
Exit Sub
End If
Else
Exit Sub
End If
End If
End Sub
お礼
ありがとうございます "yymmdd"の部分の書式を変えると H17.5.1にもなると解りました 助かりました。