Excelの表を「表組するコード」にする際、水平位置も反映してみる

昨日は、Excelの表を「表組するコード」に変換するマクロを作成してみた。
infoment.hatenablog.com

すると、全く同じような動機で、同じような試みをされている方が既に居られた。
（紹介、ありがとうございます）。
akashi-keirin.hatenablog.com

このまま終了とも思ったが、自分の勉強のためにも続けてみよう。もしかしたら、ただの再現実験になるかもしれないが、それもまたよし。

今日やりたいこと

1. Excelの表を表組するコードに変換する際、セル内の水平位置も反映させる。
2. ついでに、昨日作成したものをクラスモジュール化する。

必要なこと

1. クラスモジュールへの移植手術
2. 位置の指定方法の確認

１．クラスモジュールへの移植手術

テーブルを作成するためには、＜table＞で始まり、＜/table＞で終わる必要がある。そこで、次のように考えた。

1. クラスの初期化で、＜table＞を追加する。
2. クラスの破棄時に、＜/table＞を追加する。

【クラスモジュール】（HTMLTableClass）

Option Explicit
Public TableRange As Range
Dim col As Collection

' 初期化
Private Sub Class_Initialize()
    Set col = New Collection
        col.Add "<table>"
End Sub

' ヘッダーおよびボディ部のデータ作成
Private Sub TableBodyData()
    Dim i As Long
    Dim r As Range
        For i = 1 To TableRange.Rows.Count
            col.Add vbTab & "<tr>"
            For Each r In TableRange.Rows(i).Cells
                Select Case i
                    Case 1
                        col.Add vbTab & vbTab & "<th align=""center"">" & r & "</th>"
                    Case Else
                        col.Add vbTab & vbTab & TD(r) & r & "</td>"
                End Select
            Next
            col.Add vbTab & "</tr>"
        Next
End Sub

' テーブルの締めくくりとクリップボードへの転記
Private Sub Class_Terminate()
    Call TableBodyData
    col.Add "</table>"        
    Dim SQC As SequenceClass
    Set SQC = New SequenceClass
    Dim seq As Variant
        seq = SQC.ToArray(col)
        Debug.Print Join(seq, vbNewLine)

    Dim ClipBoad As DataObject
    Set ClipBoad = New DataObject
    
    ClipBoad.SetText Join(seq, vbNewLine)
    ClipBoad.PutInClipboard    
End Sub

ヘッダー部は、完全なる個人的趣味で、強制的に位置を中央にした。また、各セル内の位置を指定するために、とりあえず関数TD(r)で記述した。

２．位置の指定方法の確認

既にヘッダー部を強制的に中央配置したように、
＜td align=***＞
で位置を決めることが出来るらしい。そこで、クラスモジュールに更に下記を追加した。

【クラスモジュール】（HTMLTableClass）

Private Property Get TD(r As Range) As String
    Dim myAlignment As String
        myAlignment = " align="
        Select Case r.HorizontalAlignment
            Case xlLeft
                myAlignment = myAlignment & """left"""
            Case xlCenter
                myAlignment = myAlignment & """center"""
            Case xlRight
                myAlignment = myAlignment & """right"""
            Case Else
                myAlignment = ""
        End Select        
        TD = "<td" & myAlignment & ">"
End Property

結果として、標準モジュールは非常にスッキリしたものとなった。

【標準モジュール】

Sub NoteTable()
    Dim HTC As New HTMLTableClass
    Set HTC.TableRange = Selection
End Sub

結果

表に、水平位置を反映させることが出来た。

品名	値段（単価）
りんご	100
みかん	200
ばなな	300
ブロッコリー	150

明日は、色の反映にも挑戦してみる。

参考まで。