You Look Too Cool

ゆるくつくる stabuckyのブログ

Excelの表をHTMLのtableに変換するマクロ

Pocket
このエントリーをはてなブックマークに追加

HTMLで表を作るにはtableタグを使いますが、結構、面倒です。
Excelで表を作り、HTMLとして保存することができますが、余計なタグが満載です。
Excelの表から必要最小限のHTML(tableタグ)に変換するマクロを作ってみました。

仕様

  • アクティブシートに対して実行すると、新しいシートを追加して出力する。
  • 表はA1セルを左端、上端とする。
  • 表以外のセルに値をセットしない。
  • 先頭行のセルはthタグ、それ以外はtdタグとする。
  • セルの結合に対応する。
  • 文字色、背景色に対応する。

サンプル

次のようにシートにセットします。

次のように出力されます。

<table>
<tr><th>番号</th><th rowspan=1 colspan=2>品番</th><th>商品名</th></tr>
<tr><td>1</td><td>35</td><td>QWE</td><td style=color:#FF0000>りんご</td></tr>
<tr><td>2</td><td style=background-color:#FFFF00>125</td><td>RTY</td><td>みかん</td></tr>
<tr><td>3</td><td>150</td><td>UI</td><td>ぶどう</td></tr>
</table>

コード(メイン)

セルの結合に関する処理と色に関する処理があるため長くなっています。
まず表のサイズを取得します。デフォルトで200行、100列の全てのセルをチェックし値があるセルの下端と右端を探します。
セルの結合はrowspanとcolspanを設定することで表現します。上で取得した表の全てのセルをチェックしセルの結合があればrowspanとcolspanの大きさを調べます。
色は文字色と背景色について調べます。詳細は後述します。
これらの情報を元に、table, tr, th/tdを使って表を生成します。
最後にシートを追加し、HTMLを出力します。

Sub 表をHTML形式に変換()
    Const maxRowCheck = 200
    Const maxColCheck = 100
    ReDim spanInfos(maxRowCheck, maxColCheck)
    ReDim tableHtml(maxRowCheck + 2)
    Dim maxRow As Long, maxCol As Long
    Dim numRow As Long, numCol As Long
    Dim strAddress As String
    Dim posC As Long, posColon As Long
    Dim span1stRow As Long, span1stCol As Long
    Dim thisRow As Long, thisCol As Long
    Dim thisLine As String
    Dim thtd As String
    Dim cellText As String
    Dim spanInfo As String
    Dim tempColor As String, styleBGColor As String, styleColor As String
   
    '表のサイズを取得
    For numRow = 1 To maxRowCheck
        For numCol = 1 To maxColCheck
            If Cells(numRow, numCol) <> "" Then
                If maxRow < numRow Then maxRow = numRow
                If maxCol < numCol Then maxCol = numCol
            End If
        Next numCol
    Next numRow
       
    'rowspanとcolspanに関する情報を取得
    For numRow = 1 To maxRow
        For numCol = 1 To maxCol
            strAddress = Cells(numRow, numCol).MergeArea.Address(ReferenceStyle:=xlR1C1)
            posC = InStr(strAddress, "C") '「C」の位置
            posColon = InStr(strAddress, ":") '「:」の位置
            If posColon Then 'コロンあり＝セル結合あり
                span1stRow = CInt(Mid(strAddress, 2, posC - 2))
                span1stCol = CInt(Mid(strAddress, posC + 1, posColon - posC - 1))
                For thisRow = span1stRow To numRow
                    For thisCol = span1stCol To numCol
                        If thisRow = span1stRow And thisCol = span1stCol Then
                            spanInfos(thisRow, thisCol) = " rowspan=" & (numRow - span1stRow + 1) _
                                & " colspan=" & (numCol - span1stCol + 1)
                        Else
                            spanInfos(thisRow, thisCol) = "null"
                        End If
                    Next thisCol
                Next thisRow
            Else
                spanInfos(numRow, numCol) = ""
            End If
        Next numCol
    Next numRow
   
    'HTML(tableタグ)を生成
    tableHtml(0) = "<table>"
    For numRow = 1 To maxRow
        If numRow = 1 Then
            thtd = "th"
        Else
            thtd = "td"
        End If
        thisLine = ""
        For numCol = 1 To maxCol
            cellText = Cells(numRow, numCol).Text
            spanInfo = spanInfos(numRow, numCol)
            If spanInfo <> "null" Then
                '背景色に関する処理
                tempColor = rgb2html(Cells(numRow, numCol).Interior.Color)
                If tempColor <> "#FFFFFF" Then
                    styleBGColor = " style=" & "background-color:" & tempColor
                Else
                    styleBGColor = ""
                End If
                '文字色に関する処理
                tempColor = rgb2html(Cells(numRow, numCol).Font.Color)
                If tempColor <> "#000000" Then
                    styleColor = " style=" & "color:" & tempColor
                Else
                    styleColor = ""
                End If
                'th,tdタグを生成
                thisLine = thisLine & "<" & thtd & spanInfo & styleBGColor & styleColor & ">" _
                    & cellText _
                    & "</" & thtd & ">"
            End If
        Next numCol
        tableHtml(numRow) = "<tr>" & thisLine & "</tr>"
    Next numRow
    tableHtml(maxRow + 1) = "</table>"
   
    'HTMLを新しいシートに出力
    Sheets.Add
    numRow = 0
    Do
        Cells(numRow + 1, 1) = tableHtml(numRow)
        numRow = numRow + 1
    Loop Until tableHtml(numRow) = ""
End Sub

コード(色に関する処理)

前に紹介した「Excelの色をHTMLに変換」を利用してセルの色情報を表す数値(RGB関数による数値)をHTMLにおける表記(例「#FF00FF」)に変換します。

Function rgb2html(num)
    '色を表す数値(RGB関数による数値)をHTMLにおける表記(例「#FF00FF」)に変換する。
    Dim ret As String
    Dim i As Long, temp As Long
    ret = ""
    For i = 0 To 2
        temp = num Mod 256
        ret = ret & Format(Hex(temp), "00")
        num = (num - temp) / 256
    Next i
    rgb2html = "#" & ret
End Function

コード全体

コード全体をテキストファイルにしました。
上のコードをコピー＆ペーストしてもいいですが、次のファイルをダウンロードし、拡張子を「.txt」を「.bas」に変更してインポートすると簡単です。

html_table.txt

関連記事

[ 2014年7月18日 | カテゴリー: Excel | タグ: , , , ]

« | »

コメント

  1. M より:
    2020年5月1日 13:02

    office365を使っていますが、最後の1列だけ出力されます。
    操作手順など注意点はありますでしょうか。

  2. stabucky より:
    2020年5月4日 08:05

    ＞Mさん
    返信が遅くなりすみません。
    コードに誤りがありました。
    修正いたしましたので再度確認いただけると助かります。
    よろしくおねがいします。

コメントを残す

メールアドレスが公開されることはありません。 ※ が付いている欄は必須項目です

送信してください。

タグ

Amazon API App DOT Google HTML iPhone JavaScript jQuery PHP tips Twitter VBA まとめ アルゴリズム カレンダー グラフ ダレナノ ブックマークレット プラグイン 一覧 中央区 九州豚骨 入門 八王子市 千代田区 味噌 地図 変換 家系図 数学 日付 日本語 東京駅 正規表現 町田市 町田駅 相模原市中央区 相模原市緑区 確率 神田駅 解決法 都道府県 配列 関数

カテゴリー

最近の投稿

最近のコメント

固定ページ

アーカイブ

stabucky

写真

メタ情報