【Excel VBA】テーブル変換とスタイル変更～ブックの保存先を選ぶ～

母校のバンドが予選をトップ通過したと聞いて、ここ数日浮足立っている私です。
VBAでテーブル化と好みのテーブルスタイル設定のマクロ化に取り組んでいます。

前回は、オリジナルのテーブルのスタイルを作成できるようになりました。
【Excel VBA】テーブル変換とスタイル変更～標準モジュールでスタイルを新規作成する～ - ゆるおたノート

今回はこれをマクロで保存できるようにしたいと思います。

進捗
コード
- Module1: ConvertIntoTable
  - メイン
- Module3: saveWorkbook
補足（GetSaveAsFilenameメソッドの挙動）
- キャンセルボタンを押した場合
- ファイル形式の制限
  - FileFilterの指定
後記
- ちなみに…
このシリーズについて
- 次回
- 連載目次
注釈

進捗

挑戦!!と付いているモノが本記事のテーマです。

Clear!!~~選択範囲をテーブル化~~
- Clear!!~~指定範囲にテーブルがあると「実行時エラー」が発生するので、エラーが出てからOn Errorで「テーブルの解除」に進んだ方が良いかも。~~
Clear!!~~しましまの無い、罫線・見出しだけのテーブルスタイルを作る~~
- Clear!!~~テーブルスタイル関連のオブジェクト~~
- Clear!!~~TableStyleオブジェクト~~
- Clear!!~~TableStyleElementオブジェクト / TableStyleElementsコレクション~~
Clear!!~~ブックの既定のスタイルに登録する~~
挑戦!!保存先をダイアログで指定
クラスで共通処理を分離
ユーザーフォームで操作簡略化
- （もし出来れば）色は自由に選べるようにしたい

コード

Module1: ConvertIntoTable

メイン

コメント行を含めて、ブックを保存の2行と後処理の2行だけ増えました。
ひとまずこれで完成です。疲れた…

Public Sub Main()

    '念のため変数に入れておく
    Dim myRange As Range: Set myRange = Selection.CurrentRegion

    Dim myBook As Workbook:    Set myBook = ActiveWorkbook
    Dim mySheet As Worksheet: Set mySheet = myBook.ActiveSheet

    'エラー対策
    If hasListObjectOnSelection(myRange) = False Then Exit Sub

    Dim listObj As ListObject
    Set listObj = convertRangeIntoTable(mySheet, myRange)

    Set myRange = Nothing
    Set mySheet = Nothing

    '▼追加
    Call setTableStyle(myBook, listObj)

    'ブックを保存
    Call selectOverwriteOrNew(myBook)

    MsgBox "処理が完了しました。"

    '後処理
    Set listObj = Nothing
    Set myBook = Nothing

End Sub

Module3: saveWorkbook

ユーザーに保存方法を確認

また選択肢が増えました…流石にウザいかな。
でも、使う状況によって、上書きの場合と新規作成の場合とありますよね…？

Option Explicit
Option Private Module

Public Sub selectOverwriteOrNew(ByRef targetBook As Workbook)

    If MsgBox("このブックを新しいブックとして保存しますか？", vbYesNo) = vbNo Then

        If MsgBox("上書き保存しますか？", vbYesNo) = vbNo Then
            Exit Sub
        End If

        targetBook.Save

        Dim currentPath As String
        currentPath = ThisWorkbook.Path & "\" & ThisWorkbook.name

        MsgBox ("保存しました。" & vbCrLf _
              & currentPath)
        Exit Sub

    End If

    Dim newFilePath As String
    newFilePath = saveViaDialogBox(targetBook)
    MsgBox ("保存しました。" & vbCrLf _
          & newFilePath)

End Sub

新規作成する

今日の本丸。
ApplicationオブジェクトのGetSaveAsFilenameというメソッドを使って、ユーザーが保存先とファイル名を入力できるようにします。
（途中で長々書いているコメントは、GetSaveAsFilenameメソッドの使い方をメモしたものです。）

Private Function saveViaDialogBox(ByRef targetBook As Workbook) As String

    Dim newFileName As String
    Const MACRO_BOOK As String = "Excelマクロブック,*.xlsm"

    '保存先のフォルダを指定していない場合は、ダイアログには カレントフォルダ が表示される。
    '事前にChDirしたり、InitialFileNameをフルパスで指定したりも可。今回は カレントフォルダ のままで。

    ' @param {string} InitialFilename （省略可）既定値として表示するファイル名
    ' @param {string} FileFilter ファイルの候補（ファイルフィルター文字列）をカンマ区切りで
    ' @param {num} FilterIndex （省略可）FileFilterの既定のインデックス（1始まり）
    ' @param {string} Title （省略可）ダイアログボックスのタイトル
    ' @param {string} ButtonText  ※Macintosh専用
    '
    ' @return {string/boolean} ファイル名（かパス）。「キャンセル」を押すと"False"が返ってくる。

    newFileName = Application.GetSaveAsFilename(InitialFileName:=getInitialFileName(targetBook), _
                                                FileFilter:=MACRO_BOOK)

    targetBook.SaveAs Filename:=newFileName

    saveViaDialogBox = targetBook.Path & "\" & targetBook.name

End Function

これで、（新規作成の場合は）ダイアログボックスから保存先を選択出来るようになりました*1。
ダイアログボックスの出現

既定値を設定

日付でファイル名を管理したいので、ファイル名の先頭に実行日を付与するようにしました。

Private Function getInitialFileName(ByRef targetBook As Workbook) As String

    Dim fileNameWithDate As String
    '当日の日付を付与しておく
    '【例】20190516_テーブルサンプル.xlsm
    fileNameWithDate = Format(Date, "yyyymmdd") & "_" & targetBook.name

    getInitialFileName = fileNameWithDate

End Function

本日はここまで。

補足（GetSaveAsFilenameメソッドの挙動）

キャンセルボタンを押した場合

ダイアログボックスでキャンセルボタンを押すと、ファイル名がFalse.xlsmとして保存されました。
`False.xlsm`という名前で保存された…

これは、GetSaveAsFilenameメソッドの戻り値として「何も選択されてない」という意味でFalseが返ってきたからのようです。

…ということは、途中まで操作したところで間違いに気づいたりして「やっぱり保存は止めよう」となった時*2のために、分岐を作ると良いのかもしれません。

ファイル形式の制限

今回はマクロをExcelのブックに直接書いているので、「マクロ付きブック」の状態です。

このブックを、ダイアログボックスでファイル名を入力して「マクロ無しブック」として保存しようとすると、実行時エラーになりました。
実行時エラー：1004

実行時エラー'1004':

この拡張子は、選択したファイル形式には使用できません。［ファイル名］ボックスでファイル拡張子を変更するか、［ファイルの種類］ボックスで別のファイル形式を選択してください。

ブックのタイトルバーにも「保存に失敗」との表示が…
タイトルバーにも「保存に失敗しました」との表示。

つまり、今回のコードは「マクロ付きブック」で実行しているので、FileFilterという引数には実質「Excelマクロブック形式」しか選択できない状態のようです。

この点は手動で操作した場合と同じ仕様だと思いますが、処理を足さないと保存形式の選び直しはさせてくれないのですね。~~めんどくさいな…~~

`FileFilter`の指定

これを踏まえると、FileFilterの条件を増やす必要があるのは、取引先とかのバージョンに合わせて拡張子を変える時くらいでしょうか？

この場合のサンプルコードも書いてみました。先述の参照先のコードをお借りしました。

Const XLSX_BOOK As String = "Excelファイル,*.xlsx"
Const XLS_BOOK As String = "Excel2003以前,*.xls"

newFileName = Application.GetSaveAsFilename(InitialFileName:=getInitialFileName(targetBook), _
                                            FileFilter:=XLSX_BOOK & "," & XLS_BOOK)