HTMLのtable要素を作るFunction - 素人がExcelVBAによる「一人働き方改革」に挑むブログ

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>に置き換えておく。

使ってみる

f:id:akashi_keirin:20180108222554j:plain

シート（Sheet2です）にこんなふうに表を用意して、次のコードで実験してみる。

リスト２　標準モジュール

Public Sub testHTMLTable()
  Dim Sh As Worksheet
  Set Sh = ThisWorkbook.Worksheets("Sheet2")
  Debug.Print createHTMLTable(Sh.Range("A1").CurrentRegion, True, True)
End Sub

f:id:akashi_keirin:20180108222603j:plain