【Excel VBA】テーブル変換とスタイル変更 ～一発で変換とスタイル変更を済ませたい～

Excelでデータを管理する時は、テーブル機能が便利です。
1行だけ関数を設定すれば列の中は自動で式を補完してくれたり*1、範囲の変更も自動で追跡*2してくれたり*3。

ところが、テーブル化したはいいものの、Excelに元からあるテーブルスタイルがちょっと使いづらい、ということがあります。
やたらカラフルなものや、しましまが無いけど「まっさら」ものとか。極端だなぁ…
これでも使えなくはないですが、「もっと別のデザインを使いたい」こともあります。

VBAerとしてはこれを毎回手動で変更するのも面倒なので、マクロ1つで好みのスタイルでテーブル化出来るように考えてみたいと思います。

目標

実現したいこと

今考えているのは、下記の4つです。

1. 選択範囲をテーブル化
2. しましまの無い、罫線・見出しだけのテーブルスタイルを作る
3. ブックの「既定のスタイル」に登録する
4. （もし出来れば）配色は自由に選べるようにしたい

4つめは必要になった時でも良さそうですが、少しずつやってみたいと思います。

完成イメージ

こんなテーブルを作ります。罫線もうっすらと。

※何の表か気になる方はこちらへ…→*4

ちなみに…

新規作成のブックで使えるようにしたいだけであれば、「実現したいこと」の3.まで行った時点で、Excelテンプレート（.xltx）としてシステムに保存する手段もあります。ご参考まで…

マクロ

自動記録の流用

テーブル関係の設定で使うオブジェクトが分からなかったので、まずは自動記録の力を借りて、.Selectionを消したり変数を使ったりして軽く整理してみました。

あわせて、MsgBoxや名前を入れるInputBox関数を少し追加しています。

コード（整理の結果）

※かなり長いので、プロシージャごとに分割して掲載します。

【1】メイン

コレが1番長いです。

Public Sub setTable()
    
    Dim myBook As Workbook    
    Dim thisSheet As Worksheet
    Set myBook = ActiveWorkbook    
    Set thisSheet = myBook.ActiveSheet
    
    '実行準備
    Call prepareAgainstRuntimeError(thisSheet)
    
    Dim newTable As ListObject
    Set newTable = convertRangeIntoTable(thisSheet)
    
    'スタイルを作成
    Dim m As String
    m = "テーブルのスタイルも新規作成してよろしいですか？" & vbCrLf
    m = m & "適用予定のスタイル名：" & newTable.TableStyle
    If MsgBox(m, vbYesNo) = vbYes Then
        Dim newStyleName As String
        newStyleName = createStyle(myBook)
        
        newTable.TableStyle = newStyleName 'スタイルを適用
        
        '既定のスタイルに設定しておく
        myBook.DefaultTableStyle = newStyleName
    End If
    
    MsgBox "現在のテーブル・スタイル：" & newTable.TableStyle
    
    '後処理
    thisSheet.Cells(1, 1).Select
    MsgBox "テーブルに変換しました。"
    
    m = "最後に、このブックを上書き保存してよろしいですか？"
    If MsgBox(m, vbYesNo) = vbNo Then
        MsgBox "承知しました。保存は中止します。"
        Exit Sub
    End If
    
    myBook.Save
    MsgBox "保存しました。"
    
End Sub

【2】一応エラー対策

［1］ユーザーに許可をとってから次の処理へ

Private Sub prepareAgainstRuntimeError(ByRef targetSheet As Worksheet)
    
    With targetSheet
        .Cells(1, 1).Activate
        
        'テーブルの解除
        Dim m As String
        m = "選択しているシート上のテーブルを、すべて解除してもよろしいですか？" & vbCrLf
        m = m & "※選択範囲でテーブルが有効になっていると、この機能が使えません。"
        If MsgBox(m, vbYesNo) = vbYes Then Call convertTablesIntoRange(targetSheet)
            
        'オートフィルターの解除
        If .AutoFilterMode = True Then .AutoFilterMode = False
    End With
    
End Sub

［2］テーブルがあったら解除する

「範囲が被ったらエラー」になるので、エラーが出てからOn Errorで飛んできた方が良いかも。

Private Sub convertTablesIntoRange(ByRef targetSheet As Worksheet)
    
    'すべて範囲に変換
    Dim list As ListObject
    For Each list In targetSheet.ListObjects
        list.Unlist
    Next list
    
End Sub

【3】テーブルに変換

Private Function convertRangeIntoTable(ByVal targetSheet As Worksheet) As ListObject
    
    '使用範囲をテーブルに変換
    Dim newList As ListObject
    Dim newTableRange As Range
    Set newTableRange = targetSheet.Cells(1, 1).CurrentRegion
    Set newList = targetSheet.ListObjects.Add(xlSrcRange, _
                                              newTableRange, _
                                              , _
                                              xlYes)

    'テーブルの名前を設定    
    Dim newTableName As String
    newTableName = InputBox("新規作成するテーブルの名前を入力してください。")
    newList.Name = newTableName
    
    Set convertRangeIntoTable = newList
    
End Function

【4】テーブルスタイルを新規作成

［1］テーブル全体と見出し行で処理を分ける

Private Function createStyle(ByVal targetBook As Workbook) As String
    
    'スタイル名を設定
    Dim newStyle As TableStyle
    Dim newName As String
    newName = InputBox("続いて、新しいスタイルの名前を入力してください。")
    Set newStyle = targetBook.TableStyles.Add(newName)
    
    '▼テーブル全体のスタイル
    Dim black As Long:         black = RGB(0, 0, 0)
    Dim lightGray As Long: lightGray = RGB(208, 206, 206)
    
    Call setWholeStyle(newStyle, black, lightGray)
   
    '▼見出し行（ListHeaderRow）のスタイル
    Call setHearderStyle(newStyle)
   
    createStyle = newName
    
    Set newStyle = Nothing
    
End Function

［2］「テーブル全体」のスタイルを設定

Private Sub setWholeStyle(ByRef targetStyle As Variant, _
                          Optional ByVal outerLineColor As Long =  0, _
                          Optional ByVal innerLineColor As Long = 13553360)
    
    Dim wholeTableElements As Variant
    Set wholeTableElements = targetStyle.tableStyleElements(xlWholeTable)
    
    '外側のスタイル
    Dim outerLineConstants As Variant
    outerLineConstants = Array(xlEdgeTop, xlEdgeBottom, xlEdgeLeft, xlEdgeRight)
    Call setLines(wholeTableElements, outerLineConstants, outerLineColor, xlContinuous, xlMedium)
    
    '内側のスタイル
    Dim innerLineConstants As Variant
    innerLineConstants = Array(xlInsideVertical, xlInsideHorizontal)
    Call setLines(wholeTableElements, innerLineConstants, innerLineColor, xlContinuous, xlThin)
    
End Sub

［3］罫線を付ける

Private Sub setLines(ByRef StyleElements As Variant, _
                     ByRef linePositions As Variant, _
                     ByVal targetColor As Long, _
                     Optional ByVal lineStyle As Long = xlContinuous, _
                     Optional ByVal thickness As Long = xlThin)
    
    With StyleElements
        
        '罫線を1本ずつ設定
        Dim i As Long
        For i = 0 To UBound(linePositions)
            With .Borders(linePositions(i))
                .color = targetColor
                .lineStyle = lineStyle
                .Weight = thickness
            End With
        Next i
        
    End With
    
End Sub

［4］「見出し行」のスタイルを設定

Private Sub setHearderStyle(ByRef targetStyle As Variant)
    
    Dim headerRowElements As Variant
    Set headerRowElements = targetStyle.tableStyleElements(xlHeaderRow)
   
    Dim deepBlue As Long: deepBlue = RGB(0, 32, 96)
    Dim white As Long:       white = RGB(255, 255, 255)
    
    '見出し行のスタイルを設定
    With headerRowElements
        .Interior.color = deepBlue
        With .Font
            .Bold = True
            .color = white
        End With
    End With
    
End Sub

感想と気づいたこと

コードが汚い…

For文やプロシージャ化しつつ少し整理してみましたが、上から順に書き換えただけなのでなんだか流れが分かりづらいですね…
もうちょっとキレイなコードに出来ないものかと。

テーブル作成してから名前変えてる*5し、上の方の「スタイルを作成」の分岐も独立できそう。

何よりメインのプロシージャが長い！
操作が多いから仕方ないですが、1画面で全体像が見えないのでもうちょっと短くしたいです。

テーブルスタイルのオブジェクト

スタイルの変更にはこの辺をいじると良さそうです。

• TableStyleElementsコレクション / TableStyleElementオブジェクト
• TableStyleオブジェクト

Addメソッドの戻り値

この記事を書きながら調べていて分かったのですが、ListObjects.Add()するとテーブル（ListObject）ではなくテーブル名が返ってくるそうです。

（さっき↑と少し矛盾しますが）これで既定の名前を使うかどうかの選択肢が作れそうです。

<2019/05/14追記>
自分で確認し直したところ筆者の勘違いでした！大変失礼いたしました…
普通にListObjectオブジェクトが返ってきます！！

これ使える…？

保存先のダイアログ

正直まだダイアログの使い方があまり分かってないのですが苦笑、実践の方が身に付くはず、ということでチャレンジしてみます。

上記のコードでは確認無しに既存のパスに上書きしてますが、保存場所もダイアログで選べる方が良さそうです。

クラス

正直まだクラスの使い方があまり（以下略）…

setWholeStyleプロシージャ以下は共通の処理なので、色や変更する場所あたりを渡せばメインモジュールは少しスッキリするんではないかと…？（推測）

ユーザーフォーム

正直まだユーザーフォームの（以下略）…

選択肢や名前の入力が多いので、最初に一気に選べた方がウザくないし、処理もぶつ切りにならなくてユーザー目線的に良いかもしれません。

改善点がいっぱい。

書けば書くほど気になる点がガンガン出てくるのですが、全部実装できるかは全く自信がありません。
最近偉そうに書いたばっかりですが…

1つずつ学んでいきます。時間だけなら今はたっぷりあるので…！

このシリーズについて

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

もし間違いやヘンなところ等ありましたら、コメント欄やTwitter、お問い合わせフォーム等でご指摘いただけたら嬉しいです。

次回

【Excel VBA】テーブル変換とスタイル変更 ～処理の流れを整理してみる～ - ゆるおたノート

連載目次

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

注釈

*1:書いたことは無いけど、たぶんイベントトリガーでGASを動かせば同じようなことはできるのかもしれませんが…

*2:構造化参照というそうです。

*3:最近は一部Googleスプレッドシートに頼ることもありますが、クラウドでデータ保管することにもまだ不安があったりして、完全にExcelから卒業するにはもうちょっと時間がかかりそうです。

*4:8月にメジャーデビュー予定の「BEYOOOOONDS」です。"びよーんず"と読みます。

まだ公式MVが無いのでこちら↓を…
<2020/08/22追記>
更新忘れてましたが公式MVが出ました！
ピコピコ8bit音が楽しいミュージカル風の奇曲です。
BEYOOOOONDS『眼鏡の男の子』(BEYOOOOONDS [The boy with the glasses.])(Promotion Edit) - YouTube

*5:これは自動記録あるあるですね。