ゆるおたノート

Tomorrow is another day.

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

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

前回は、オリジナルのテーブルのスタイルを作成できるようになりました。
https://yuru-wota.hateblo.jp/entry/change-table-style-elementsyuru-wota.hateblo.jp

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

進捗

赤字の【Clear!!】が本記事のテーマです。


  1. 【Clear!!】 選択範囲をテーブル化
    • 【Clear!!】 指定範囲にテーブルがあると「実行時エラー」が発生するので、エラーが出てからOn Errorで「テーブルの解除」に進んだ方が良いかも。
    • 【NG】ListObject.Addメソッドの戻り値で既定の名前も選択可。
  2. 【Clear!!】 しましまの無い、罫線・見出しだけのテーブルスタイルを作る
    • 【Clear!!】 テーブルスタイル関連のオブジェクト
    • 【Clear!!】 TableStyleオブジェクト
    • 【Clear!!】 TableStyleElementオブジェクト / TableStyleElementsコレクション
  3. 【Clear!!】 ブックの既定のスタイルに登録する
  4. 【Clear!!】保存先をダイアログで指定
  5. クラスで共通処理を分離
  6. ユーザーフォームで操作簡略化
    • (もし出来れば)色は自由に選べるようにしたい

コード

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
新規作成する

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

ダイアログボックスの出現

コードはこちら。

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
既定値を設定

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

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として保存されました。
これはGetSaveAsFilenameメソッドの戻り値としてFalseが返ってきたからのようです。

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

拡張子の選択

ダイアログボックスでファイル名を入力し、「マクロ付きブック」を「マクロ無しブック」として保存(もしくはその逆)しようとすると、実行時エラーになりました。

プルダウンリストの選択肢も増えます。

実行時エラー:1004

ブックのタイトルバーでも「保存に失敗」との表示。

保存に失敗しました

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

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

FileFilterの指定

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

この場合のサンプルコードはこちら。
先述の参照先のコードをお借りしました。

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)

カンマ区切りをさらにカンマ区切りするのが面白いですね。
COUNTIFS関数みたいな。

後記

コード自体はそんなに難しくなかったと思うのですが、引数の使い方がちょっと注意が要りそうだなと思いました。

あと、ファイルの操作ならFileSytemObjectなのかなと予想してたのに、違うみたいです(よく分かってない)。

入門者からの出口はまだまだ遠そうです…

ちなみに…

本日限定ですが、Twitterでアンケートを作ってみました*3
ご回答いただけたら嬉しいです。

無知のくせに思い込みしやすい性格なので、出来るだけ多くの方のご意見を聞いて知識をアップデートして行きたいと思います。

このシリーズについて

テーブルの変換とテーブルスタイルの新規作成をマクロ1発で使えるように考えています。主に自分向け。

もし間違いや改善のアイディア等ありましたら、コメント欄やTwitter等でご意見いただけたら嬉しいです。

次回

Coming Soon...

連載目次

  1. 【Excel VBA】一発でテーブルの変換とスタイル変更をしたい - ゆるオタクのすすめ
  2. 【Excel VBA】テーブル変換とスタイル変更 - 処理の流れを整理してみる - ゆるオタクのすすめ
  3. 【Excel VBA】テーブル変換とスタイル変更 - テーブル変換するところまで標準モジュールで書いてみる - ゆるオタクのすすめ
  4. 【Excel VBA】テーブル変換とスタイル変更 - 標準モジュールでスタイルを新規作成する - ゆるオタクのすすめ
  5. (本記事)【Excel VBA】テーブル変換とスタイル変更 - ブックの保存先を選ぶ - ゆるオタクのすすめ

注釈

*1: こちらを参照させていただきました。 excel-ubara.com

*2: 私はよくあるのです…

*3: ツイート2件とも同じこと言ってたり、画像のメッセージボックスが足りてないのは見逃してください…