ゆるおたノート

Tomorrow is another day.

【Excel VBA】テーブル変換とスタイル変更 - 標準モジュールでスタイルを新規作成する

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

前回は、先日のフロー図(過去記事)をもとにテーブル化まで
コードを書きました。
yuru-wota.hateblo.jp

今回も引き続きテーブルのスタイルを指定するところまで
書いていきます。

進捗

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


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

<2019/05/17追記>
3. の【Clear!!】が抜けていたので修正しました。

コード

Module1: ConvertIntoTable

Mainプロシージャには、Call setTableStyle~の1行だけ
追加になりました。

また、1行目の選択範囲の反映を調整しています。
この場合、以下のような挙動になります。


  • 表の一部分のみ選択されている場合は、表全体*1を取得しテーブル化。
  • 表が複数含まれている場合は、左上の表のみテーブル化。

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
    
    '▼追加
    Call setTableStyle(myBook, listObj)
    
    
    
    'ブックを保存
    
    
    
    MsgBox "処理が完了しました。"
    
End Sub

さて、Module2は省略しまして…

Module3: createTableStyle

このモジュールのメイン

初期コード(過去記事)のMainプロシージャから、一連の処理ごと
独立したモジュールとしました。
今回はクラスではないですが、専門用語的には「単一責任原則」*2
と言うようです。

Do While ~ Loopの部分をさらにプロシージャ化できないかな…

Option Explicit
Option Private Module

Public Sub setTableStyle(ByRef targetBook As Workbook, _
                         ByRef targetListObj As ListObject)
                                       
    If isOkToCreateTableStyle = False Then Exit Sub

    Dim defaultStyleName As String
    defaultStyleName = targetListObj.TableStyle
    Dim newStyleName As String
    newStyleName = inputStyleName(defaultStyleName)
    
    Do While (newStyleName = defaultStyleName) _
           Or isExistStyleName(targetBook, newStyleName)
    
        If MsgBox("指定の名前は既に存在しています。こちらを適用しますか?", vbYesNo) = vbYes Then
            MsgBox "既定のテーブルスタイルを適用します。"
            Exit Sub 'スタイルは変更せずに終了
        End If
    
        MsgBox "お手数ですが、もう1度スタイルの名前を登録して下さい。"
        newStyleName = inputStyleName(defaultStyleName)
        
    Loop
    
    Dim newStyle As TableStyle
    Set newStyle = targetBook.TableStyles.Add(newStyleName)
    Call changeTableDesign(newStyle)
    
    '既定のスタイルに設定しておく
    targetBook.DefaultTableStyle = newStyleName
    
    targetListObj.TableStyle = newStyle
       
End Sub
一旦ユーザーに意向確認

不要なら今回の処理はすべて飛ばします。

Private Function isOkToCreateTableStyle()

    If MsgBox("テーブルのスタイルも新規作成しますか?", vbYesNo) = vbNo Then
        MsgBox "承知しました。スタイルの作成は中止します。"
        isOkToCreateTableStyle = False
        Exit Function
    End If

    isOkToCreateTableStyle = True

End Function
名前を入力してもらう

初期のコードと同じなので、説明は省略します。

Private Function inputStyleName(ByRef defaultStyleName As String) As String

    Dim newStyleName As String
    newStyleName = InputBox(Prompt:="新しいスタイルの名前を入力してください" & vbCrLf & _
                                    "既定の名前:" & defaultStyleName, _
                            Default:=defaultStyleName)

    inputStyleName = newStyleName
    
End Function

ところで、昨日もテーブル名の設定で触れた「文字列の入力問題」
について、Twitterにて下記のご意見をいただきました。


「テーブルの1行目の左端にはインデックスが入っていると
ルールのお約束があって、そのセルに「〇〇ID」と項目名があれば、
自動でテーブル名が「〇〇」になるとかもできそうですね。」


スタイル名の入力と合わせて、シート上で設定出来るようにすれば
ユーザーにとっても使いやすそうですね。

ユーザーフォームも作成不要・学習不要で一石三鳥!

既定の名前と見比べる

被るものがあると、スタイルを作成する時にエラーになるので
チェックします。

ただし、TableStylesコレクションはインデックスが
「0始まり」ではなく「1始まり」みたいなんですよね…不思議。

Private Function isExistStyleName(ByRef targetBook As Workbook, _
                                  ByVal newStyleName As String) As Boolean
    
    Dim i As Long
    For i = 1 To targetBook.TableStyles.count
        If newStyleName = targetBook.TableStyles(i).Name Then
            isExistStyleName = True
            Exit Function
        End If
    Next
    
    isExistStyleName = False
End Function
テーブルスタイルの内容を変更

TableStyles.Add()を同モジュールのプロシージャ1つ目に
移動して初期のコード(過去記事)と役割が変わったので、
プロシージャ名を変更しました。

引き数は一部省略可(後述)ですが、今回は省略せずに書いています。

Private Sub changeTableDesign(ByRef tableStyleObj As Variant)
                                               
    'テーブル全体(WholeStyle)
    Dim black As Long: black = RGB(0, 0, 0)
    Dim lightGray As Long: lightGray = RGB(208, 206, 206)
    
    Call setWholeStyle(tableStyleObj, black, lightGray)
    
    '見出し行(HeaderRowStyle)
    Dim deepBlue As Long: deepBlue = RGB(0, 32, 96)
    Dim white As Long: white = RGB(255, 255, 255)

    Call setHeaderStyle(tableStyleObj, deepBlue, white, True)

End Sub
テーブルの罫線を設定

お好みですが、あらかじめ既定値を決めます。
(↑と同じですが)私はイミディエイトウィンドウで
RGB()関数の値を確認してみました。

? RGB(0, 0, 0) 'black
0
? RGB(208, 206, 206) 'lightGray
13553360

上記を基準に、Optionalで既定値を設定。
便宜的に改行も足してみましたが、元の方が読みやすかったかも…

Private Sub setWholeStyle(ByRef tableStyleObj As Variant, _
                          Optional ByVal outerLineColor As Long = 0, _
                          Optional ByVal innerLineColor As Long = 13553360)

    Dim wholeTableElements As Variant
    Set wholeTableElements = tableStyleObj.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
罫線を付ける

xlContinuousがいわゆる「実線」、xlThinは初期設定の太さ。

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
        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
見出し行の色を設定

罫線と同様、規定値を取得しています。

? RGB(0, 32, 96) 'deepBlue
16777215
? RGB(255, 255, 255) 'white
6299648

色や.Boldプロパティはお好みで変更可ということで、
こちらもOptionalです。

Private Sub setHeaderStyle(ByRef tableStyleObj As Variant, _
                           Optional ByVal interiorColor As Long = 16777215, _
                           Optional ByVal fontColor As Long = 6299648, _
                           Optional ByVal isBold As Boolean = True)

   Dim headerRowElements As Variant
   Set headerRowElements = tableStyleObj.TableStyleElements(xlHeaderRow)
   
    With headerRowElements
        
        .Interior.Color = interiorColor
        
        With .Font
            .Color = fontColor
            .Bold = isBold
        End With
    
    End With

End Sub

本日はここまで!

後記

最近気づいたのですが、コードを書くだけなら何時間でも
PCに向かっていられることに気付きました。
お陰でかなり夜更かし気味ではありますが…

相変わらず勘違いが多かったり難しいことはあまり出来なかったりで
「100%楽しい!」とは言い難いものの、VBAは特に書いた結果が
すぐ見えるというのが大きい気がします。

これが生活にも生かせると良いんですけどね…

あとは、もっと文章力が付いたらブログ書くのももっと楽しいんだろうなと。
今は、とにかく時間がかかってしまうので、やや苦行気味…
さっぱりサクッと書くにはどうしたら良いのかな。

ライティングの効率化とあわせて勉強していきたいです。

このシリーズについて

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

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

次回

https://yuru-wota.hateblo.jp/entry/VBA/overwrite-save-or-newyuru-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:CurrentRegionプロパティそのものの働きについては、下記をご参照ください。(外部サイト)
tonari-it.com

*2: qiita.com