Excelの表を「表組するコード」にする際、セル内の色も反映してみる

昨日は、Excelの表を表組コードに変換する際、併せて水平位置を反映した。
infoment.hatenablog.com

今日は、セル内の色も反映することに挑戦する。
f:id:Infoment:20181013132931p:plain

最初の失敗

実に、安易に考えていた。Interior.Color で得た値を、そのまま与えれば良いのかな?程度の検討で。
f:id:Infoment:20181013133316p:plain

    Dim myColor As String
        myColor = " bgcolor=" & R.Interior.Color        
        TD = "<td" & myAlignment & myColor & ">"

結果は、こんな感じ。

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

何だこれは、何でこんなことに!?調べてみて、直ぐに判明。ここは16進数カラーコードで設定しないと駄目だそうな。

二度目の失敗

16進数カラーコード?「#FFFFFF」とかの、あれか。今まで目にしたことはあったけど、深く考えたことはなかった。調べてみると10進数を16進数に変換する、HEX関数というものがあるらしい。良く考えずに、安易に変更。

    Dim myColor As String
        myColor = " bgcolor=" & "#" & Hex(R.Interior.Color) 
        
        TD = "<td" & myAlignment & myColor & ">"

結果は、こんな感じ。

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

何だこれは。でも、言い訳になるけど、そんな気がしていた。

三度目の正直

まじめに調べてみると、HTMLで用いるカラーコードは、RGB(赤,緑,青)の値を16進数(二桁)で以下のように表した値らしい。
f:id:Infoment:20181013135058p:plain

また、計算式は下記の通り。
f:id:Infoment:20181013135431p:plain

そこで、これを真面目に展開してみた。
f:id:Infoment:20181013140619p:plain
f:id:Infoment:20181013140539p:plain
f:id:Infoment:20181013140846p:plain

更に、これをクラスモジュール化する。

【クラスモジュール】(HTMLColorClass)
Option Explicit

Public DexNumber As Long

Private Property Get R() As Long
    R = DexNumber Mod 256
End Property

Private Property Get G() As Long
    G = ((DexNumber - R) / 256) Mod 256
End Property

Private Property Get B() As Long
    B = (DexNumber - R - 256 * G) / 256 / 256
End Property

Public Function HTMLColor() As String
    HTMLColor = "#" & _
                CStr(Format(Hex(R), "00")) & _
                CStr(Format(Hex(G), "00")) & _
                CStr(Format(Hex(B), "00"))
End Function

これを改めて、昨日のクラスモジュールに盛り込んでみる。

【クラスモジュール】(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
    
    Dim HCC As New HTMLColorClass
        HCC.DexNumber = R.Interior.Color
    
    Dim myColor As String
        myColor = " bgcolor=" & HCC.HTMLColor
        
        TD = "<td" & myAlignment & myColor & ">"

End Property

結果

色も含めて、反映させることが出来た。
f:id:Infoment:20181013133316p:plain

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

参考まで。