HTMLのtable要素を作る
HTMLで表を作るのはメンドクサイ
Excelでちゃちゃっと表を作って、それをHTMLタグで囲って構造化するマクロを作った。
リスト１ 標準モジュール
Public Function createHTMLTable( _
ByVal targetRange As Range, _
Optional ByVal hasHeader As Boolean = True, _
Optional ByVal hasBorder As Boolean) As String '……(1)'
Dim rowCount As Long '……(2)'
rowCount = targetRange.Rows.Count
Dim columnCount As Long
columnCount = targetRange.Columns.Count
Dim i As Long
Dim j As Long
Dim stringOfCell() As String '……(3)'
ReDim stringOfCell(0 To rowCount - 1, 0 To columnCount - 1)
For i = 0 To rowCount - 1
For j = 0 To columnCount - 1
stringOfCell(i, j) = targetRange.Cells(i + 1, j + 1).Value
Next
Next
Dim str As String
If hasBorder Then '……(4)'
str = "<table border=""1"">"
Else
str = "<table border="""">"
End If
For i = 1 To rowCount '……(5)'
str = str & "<tr>" '……(6)'
For j = 1 To columnCount '……(7)'
If hasHeader And i = 1 Then '……(8)'
str = str & "<th>" & stringOfCell(i - 1, j - 1) & "</th>"
Else
str = str & "<td>" & stringOfCell(i - 1, j - 1) & "</td>"
End If
Next
str = str & "</tr>" '……(9)'
Next
str = str & "</table>" '……(10)'
str = Replace(str, vbLf, "<br>") '……(11)'
createHTMLTable = str
End Function
(1)の
Public Function createHTMLTable( _
ByVal targetRange As Range, _
Optional ByVal hasHeader As Boolean = True, _
Optional ByVal hasBorder As Boolean) As String
では、引数３つと返り値の型を設定。
第１引数では、対象のセル範囲を指定。
第２引数は、表が項目ラベルを持っているかどうか。持っているならTrue。
第３引数は、境界線をどうするか。Trueだったらborder属性に"1"をセットする。Falseなら""。
で、返り値はString型。
(2)からの４行
Dim rowCount As Long rowCount = targetRange.Rows.Count Dim columnCount As Long columnCount = targetRange.Columns.Count
では、表の行数・列数を変数にぶち込んでおく。
(3)からの７行
Dim stringOfCell() As String
ReDim stringOfCell(0 To rowCount - 1, 0 To columnCount - 1)
For i = 0 To rowCount - 1
For j = 0 To columnCount - 1
stringOfCell(i, j) = targetRange.Cells(i + 1, j + 1).Value
Next
Next
では、String型の２次元配列stringOfCell()に表の各セルの値をぶち込んでいる。
もっと簡単にできたと思うけれど、調べるのがめんどくさいんで（←コラ！）、とりあえずこういう原始的なやり方で。
(4)からの５行
If hasBorder Then str = "<table border=""1"">" Else str = "<table border="""">" End If
では、引数hasBorderの値に応じて、tableの開始タグを書き分けている。
で、(5)からの11行
For i = 1 To rowCount
str = str & "<tr>" '……(6)'
For j = 1 To columnCount '……(7)'
If hasHeader And i = 1 Then '……(8)'
str = str & "<th>" & stringOfCell(i - 1, j - 1) & "</th>"
Else
str = str & "<td>" & stringOfCell(i - 1, j - 1) & "</td>"
End If
Next
str = str & "</tr>" '……(9)'
Next
二重のForループで一気にtableタグの中身を作っていく。
まず、外側のForループでは、表の各行を作っていくので、ループの最初に(6)の
str = str & "<tr>"
で<tr>タグを付け足し、次のループに移る直前に(9)の
str = str & "</tr>"
で</tr>タグを付け足すようにしている。
また、内側のForループ、すなわち(7)からの７行
For j = 1 To columnCount
If hasHeader And i = 1 Then '……(8)'
str = str & "<th>" & stringOfCell(i - 1, j - 1) & "</th>"
Else
str = str & "<td>" & stringOfCell(i - 1, j - 1) & "</td>"
End If
Next
では、引数hasHeaderの状態に応じて分岐。(8)の
If hasHeader And i = 1 Then
でhasHeaderがTrueで、かつ i = 1 のとき、つまり表の１行目が各列のラベルである場合は、セルの値を<th></th>で囲まないといけないので、このような条件分岐にしている。
hasHeader And i = 1
がTrueのときは、
str = str & "<th>" & stringOfCell(i - 1, j - 1) & "</th>"
によって、セルの値を<th></th>でくくった文字列をstrに追加し、
hasHeader And i = 1
がFalseのときは、
str = str & "<td>" & stringOfCell(i - 1, j - 1) & "</td>"
によって、セルの値を<td></td>でくくる、という仕掛け。
二重のForループから抜けると、表の中身は全てタグ打ちができているはずなので、(10)の
str = str & "</table>"
でtableタグを閉じる。
ついでに、(11)の
str = Replace(str, vbLf, "<br>")
では、Replace関数を用いて、セル内改行（vbLf）を<br>に置き換えておく。
使ってみる
シート（Sheet2です）にこんなふうに表を用意して、次のコードで実験してみる。
リスト２ 標準モジュール
Public Sub testHTMLTable()
Dim Sh As Worksheet
Set Sh = ThisWorkbook.Worksheets("Sheet2")
Debug.Print createHTMLTable(Sh.Range("A1").CurrentRegion, True, True)
End Sub
イミディエイトに、タグ打ちした文字列が表示されるので、それをHTMLソースにコピペしてブラウザで開いてみた。
セル内改行した表でも実験してみたが、
こんなふうに、うまく表示された。
おわりに
Excelでちょこちょこっと表を作って、table要素にできたらいいなーと思っただけです。
「ちょｗｗｗ もっと簡単にできるじゃねーかよｗｗｗ」とか、笑われるかもしれませんが、HTMLなんてつい最近までろくに知らなかったし、Webページを触るようなこともしたことがなかったので、ホームページビルダー（っていうの？）なんかも触ったことのない素人の思いつきですから、笑って許してくだされ。
しっかし、これ、セルの結合とかに対応しようとしたら、途端に激ムズになるんじゃね？？？
