ゆるおたノート

Tomorrow is another day.

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

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

前回書いたフロー図をもとに、早速コーディングしていきます。
yuru-wota.hateblo.jp

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

進捗

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


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

コード

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
        
        .Name = InputBox(Prompt:="テーブル名を入力して下さい。" & vbCrLf & _
                                 "既定の名前:" & defaultListName, _
                         Default:=defaultListName)
    End With

End Sub

InputBox()関数の引数のうちDefaultに値を渡しておくと、
はじめから入力欄に値が入った状態でInputBoxが開きます。

InputBox()関数にDefault値を与えると、既に値が入った状態でボックスが開く

ただ、入力値とデフォルト値が一致した時の処理も追加した方が良さそう…

キリがない。サグラダファミリア

感想

やってることは初回のコード(過去記事)とほぼ同じなのですが、
エラー処理の流れを修正してみました。読みやすさが上がっていると良いのですが…

ただ、あまり細分化し過ぎると逆に読みづらくなるような気がしていて、
その塩梅が難しいです。これはどこで学べるんだろう…写経しかないのかな?

余談

実は、このコードを書くためにVSCode使ってみたりRubberduckなる
VBEのアドインを入れてみたり*5しました。

が、操作が理解できず、コメント増やしつつ数時間分かけて書いたコードを
全消去してしまって絶望…脱線した罰かな。泣

でも、1回書くと何となく流れを覚えているみたいで、
その日のうちに戻せました。(良かった…)

メゲずに続けます。

このシリーズについて

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

もし間違いやヘンなところ等ありましたら、コメント欄やTwitter
ご指摘いただけたら嬉しいです。

次回

yuru-wota.hateblo.jp

連載目次

  1. 【Excel VBA】一発でテーブルの変換とスタイル変更をしたい - ゆるオタクのすすめ
  2. 【Excel VBA】テーブル変換とスタイル変更 - 処理の流れを整理してみる - ゆるオタクのすすめ
  3. (本記事)【Excel VBA】テーブル変換とスタイル変更 - テーブル変換するところまで標準モジュールで書いてみる - ゆるオタクのすすめ
  4. 【Excel VBA】テーブル変換とスタイル変更 - 標準モジュールでスタイルを新規作成する - ゆるオタクのすすめ
  5. https://yuru-wota.hateblo.jp/entry/VBA/overwrite-save-or-new

注釈

*1: 「頭痛が痛い」みたいな…

*2:詳しくはこちらを… docs.microsoft.com

*3: 詳しくはこちら。本職でなくても勉強になります。
サンプルはJavaScriptなのかな? qiita.com

*4: ありがとうございます!!
※出典?とされているimihitoさんの記事は見つけられませんでした…
thom.hateblo.jp www.asahi-net.or.jp

*5: Rubberduckは何故か認識されなかったのでまた今度時間を作って試します…