【Excel VBA】テーブル変換とスタイル変更～テーブル変換するところまで標準モジュールで書いてみる～

VBAでテーブル化と好みのテーブルスタイル設定のマクロ化に取り組んでいます。

前回書いたフローチャートをもとに、早速コーディングしていきます。
【Excel VBA】テーブル変換とスタイル変更～処理の流れを整理してみる～ - ゆるおたノート

今回は、テーブル（ListObjectオブジェクト*1）を生成するところまで書きました。

進捗
コード
- Module1：ConvertIntoTable
- Module2：createListObj
  - オートフィルターを解除
  - テーブルの名前を決める
感想
- 余談
このシリーズについて
- 次回
- 連載目次
注釈

進捗

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

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

コード

Module1：ConvertIntoTable

Mainプロシージャ

On Error GoTo ～はなるべく使いたくないので、一旦canContinueProcess()関数で状況を判定してから先に進めます。

このまま行けば、Mainプロシージャの長さはほぼ1画面に納められそう。（my PC調べ）

Option Explicit

Public Sub Main()

    '念のため変数に入れておく
    Dim myRange As Range: Set myRange = Selection
    Dim myBook As Workbook: Set myBook = ActiveWorkbook
    Dim mySheet As Worksheet: Set mySheet = myBook.ActiveSheet

    'エラー対策
    If canContinueProcess(myRange) = False Then
        Exit Sub '=続行不能なら処理は中止する
    End If

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

    Set myRange = Nothing

    '
    '～コーディング中～
    '

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

End Sub

選択範囲にテーブルがあるかチェック

If文などの制御構文は、可能な限りネストさせないようにすると可読性が上がってコードの安全性も向上するので*3、単純なIf文2つで書いています。

ただし、そうすることで条件式が二重否定（Not ～ = False など）になってしまうような時は、かえって読みづらくなりがちなので、ほかの表現を考えます。
例えば肯定文に書き換えるとか。

Private Function canContinueProcess(ByRef targetRange As Range) As Boolean

    If targetRange.ListObject Is Nothing = True Then
        canContinueProcess = True
        Exit Function
    End If

    If MsgBox("指定範囲にテーブルがあります。" & vbCrLf & _
              "こちらをすべて解除してもよろしいですか？", vbYesNo) = vbYes Then

        Call unlistAllTables(targetRange)
        canContinueProcess = True
        Exit Function
    End If

    MsgBox "かしこまりました。処理を中止します。"
    canContinueProcess = False

End Function

選択範囲上あるテーブルは解除する

前回の記事で書いた通り、.TableStyleプロパティに空文字""を代入するとテーブルのスタイルを「まっさら」状態に出来ます。

Private Sub unlistAllTables(ByRef targetRange As Range)

    Do
        With targetRange.ListObject
            .TableStyle = "" '（お好みで）テーブルのスタイルも初期化
            .Unlist
        End With
    Loop Until targetRange.ListObject Is Nothing

    MsgBox "解除しました。"

End Sub

Module2：createListObj

ここから本番です。
処理のテーマが変わるので、念のためモジュールを分離しました。

※Privateなプロシージャをモジュール分けするときは、モジュールの宣言セクションにOption Private Moduleと書くと、ツールバーの選択肢に上がらなくなります！すごい…！*4

Option Explicit
Option Private Module '他モジュールからアクセス可能なまま、一覧からは隠す

Public Function convertRangeIntoTable(ByRef targetSheet As Worksheet, _
                                      ByRef targetRange) As ListObject

    On Error GoTo checkAutoFilter 'エラーが出たらジャンプ
    Dim newListObj As ListObject
    'エラーが出るならココ↓
    Set newListObj = targetSheet.ListObjects.Add(SourceType:=xlSrcRange, _
                                                 Source:=targetRange, _
                                                 XlListObjectHasHeaders:=xlYes)

    On Error GoTo 0 'ジャンプ命令を解除

    Call setTableName(newListObj)
    Set convertRangeIntoTable = newListObj

    Exit Function '書き忘れると"End Function"（↓）まで進んで更にエラー処理される…

'エラー処理
checkAutoFilter:

    unsetAutoFilter (targetSheet)
    Resume 'エラー発生箇所に戻る

    MsgBox "予期せぬエラーが発生しました。処理を中止します。" '起こるかな…？
    Stop 'もし"Resume"を越えたら異常事態

    Set convertRangeIntoTable = Nothing

End Function

オートフィルターを解除

既に実行時エラーが発生しないように対策していますが、それでもエラーになる時用に。
上記プロシージャのcheckAutoFilterラベル以下のエラー処理に入って、こちらのunsetAutoFilterプロシージャに飛んできます。

この段階ではフィルターが掛ったままの可能性があるので、一旦これをOff。
それでもエラーになる場合の対処法は…ごめんなさい、まだ分かりません…

Private Sub unsetAutoFilter(ByRef targetSheet As Worksheet)

    With targetSheet
        If .AutoFilterMode = True Then
            .AutoFilterMode = False
        End If
    End With

End Sub

テーブルの名前を決める

エラー処理が終わって無事テーブルを生成できたら、今度はテーブルの名前を決めます。

Private Sub setTableName(ByRef targetListObj As ListObject)

    With targetListObj
        Dim defaultListName As String
        defaultListName = .Name

        Dim m As String
        m = "テーブル名を入力して下さい。" & vbCrLf
        m = m & "既定の名前：" & defaultListName

        .Name = InputBox(Prompt:=m, Default:=defaultListName)
    End With

End Sub