選択セル値をブック名にブックを新規保存するマクロ

Wordの便利機能として、名前を付けて保存をした際に、
先頭行のタイトルが保存ファイル名初期値になってくれる機能があります。

この機能がExcelにあると便利と思いましたので、
選択セルの値を初期値として新規保存ダイアログを開くマクロを作ってみました。

実行型の便利マクロですので、
Excel起動時に裏で開かれる「個人用マクロブック」などに搭載して使ってください。

ショートカットキーに登録したり、ツールバーやリボンにボタン配置すると便利です。

新規保存「F12」を上書きしたり、Ctrl+Shift+Sにセットするのがおすすめです。

ソースコード

Sub セル値をブック名初期値として新規保存ダイアログを開く()
    
    Dim ブック名初期値 As String: ブック名初期値 = ActiveCell.Value
    
    Dim 保存ファイルパス As Variant
    保存ファイルパス = Application.GetSaveAsFilename(ブック名初期値, FileFilter:="Excelブック,*.xlsx,Excelマクロ,*.xlsm")
    If 保存ファイルパス = False Then Exit Sub
    
    Select Case Right(保存ファイルパス, 4)
    Case "xlsx"
        ActiveWorkbook.SaveAs 保存ファイルパス
    Case "xlsm"
        ActiveWorkbook.SaveAs 保存ファイルパス, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    Case Else
        MsgBox "xlsx,xlsm以外の拡張子が指定されたため保存出来ませんでした。"
    End Select
    
End Sub

解説

中身は非常に単純なマクロですね。

Application.GetSaveAsFilenameを使って名前を付けて保存ダイアログを開き、
ユーザーから受け取ったファイルパスでブックを新規保存しているコードです。

GetSaveAsFilenameは新規保存ダイアログからファイルパスを受け取るだけなので、
そのあとそのファイルパスを渡してSaveAsメソッドを実行する必要があります。

その際、xlsxとxlsmでFileFormatを変える必要がある点にご注意ください。

xlsm保存ミス対策版

ブックの保存時によくあるミスとして、
マクロがあるのにxlsxとして保存してしまうことがあります。

せっかく作ったコードが消えて泣いた経験は誰しもありますよね(´∀｀;)

この対策として、
「標準モジュールがひとつでもあるならxlsm限定でダイアログを開く」
機能を実装したバージョンがこちらです。

なお、VBAからVBEを操作するにはひとつセキュリティ設定を切る必要があり、

「開発」⇒「マクロのセキュリティ」⇒
「VBA プロジェクト オブジェクト モデルへのアクセスを信頼する」

にチェックを入れることで以下のマクロは使用可能になります。

セキュリティに関することなので、このセキュリティの詳しい説明と、
各汎用関数のご使用は、自己責任でお願いいたします。

Sub セル値をブック名初期値として新規保存ダイアログを開く()
    
    Dim ブック名初期値 As String: ブック名初期値 = ActiveCell.Value
    
    Dim 保存ファイルパス As Variant
    If Is標準モジュールが存在する(ActiveWorkbook) Then
        保存ファイルパス = Application.GetSaveAsFilename(ブック名初期値, FileFilter:="Excelマクロ,*.xlsm")
    Else
        保存ファイルパス = Application.GetSaveAsFilename(ブック名初期値, FileFilter:="Excelブック,*.xlsx,Excelマクロ,*.xlsm")
    End If
    If 保存ファイルパス = False Then Exit Sub
    
    Select Case Right(保存ファイルパス, 4)
    Case "xlsx"
        ActiveWorkbook.SaveAs 保存ファイルパス
    Case "xlsm"
        ActiveWorkbook.SaveAs 保存ファイルパス, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    Case Else
        MsgBox "xlsx,xlsm以外の拡張子が指定されたため保存出来ませんでした。"
    End Select
    
End Sub

Function Is標準モジュールが存在する(wb指定ブック As Workbook) As Boolean
    With wb指定ブック.VBProject
        Dim モジュール As Object
        For Each モジュール In .VBComponents
            If モジュール.Type = 1 Then
                Is標準モジュールが存在する = True
                Exit Function
            End If
        Next
    End With
End Function

これで標準モジュールがあるブックがxlsxで保存されることはなくなります。

この失敗で泣いたことがある方は、ぜひともこのマクロを導入してみてください。