HTMLのtable要素を作るFunction(2)
HTMLのtable要素を作成するマクロの改良
前回の
こいつを改良してみた。
行・列結合への対応
HTMLのtable要素で、行結合とか列結合をする場合は、タグとかタグの中に、それぞれ「rowspan="2"」とか、「colspan="3"」などと書き込むだけで良いので、そんなに難しくないのではないか、と思った。
確認
まず、Excelのシート上に
こんな表を作ってみた。
んで、次のようなコードを書いて、それぞれのセルの値がどのように取得されるのか確認してみた。
リスト１ 標準モジュール
Public Sub testMethod(targetRange As Range)
Dim Sh As Worksheet
Set Sh = targetRange.Parent
Dim startRow As Integer
Dim startColumn As Integer
Dim endRow As Integer
Dim endColumn As Integer
With targetRange
With .Cells(1, 1)
startRow = .Row
startColumn = .Column
End With
endRow = startRow + .Rows.Count - 1
endColumn = startColumn + .Columns.Count - 1
End With
Dim i As Integer
Dim j As Integer
Dim str As String
Dim tmp As String
For i = startRow To endRow
str = ""
For j = startColumn To endColumn
With Sh.Cells(i, j) '……(1)'
If .Value = "" Then '……(2)'
tmp = "*"
Else
tmp = .Value
End If
If j <> endColumn Then '……(3)'
str = str & tmp & " | "
Else
str = str & tmp
End If
End With
Next
Debug.Print str '……(4)'
Next
End Sub
えらくタテ長になってしまった。
簡単なコードなので、説明は最小限にとどめる。
(1)からの６行
With Sh.Cells(i, j) '……(1)' If .Value = "" Then '……(2)' tmp = "*" Else tmp = .Value End If '……(中略)……' End With
では、対象の表の各セルの値について調べ、(2)の
If .Value = "" Then tmp = "*" Else tmp = .Value End If
で、値がなかったら変数tmpに「*」をぶち込み、値が入っていたら変数tmpにその値をぶち込むようにしている。
(3)の
If j <> endColumn Then str = str & tmp & " | " Else str = str & tmp End If
では、最終列に到達するまでは、変数strにtmpの値と「 | 」を付け加え、最終列に到達したときだけ「 | 」を付け加えないようにしている。まあ、ここは、別に最後に右端の「 | 」を取り除くような処理でも良いと思う。
内側のForループ（イテレータが j の方）を抜けたら、１行分完成ということなので、(4)の
Debug.Print str
でstrの内容、すなわち１行分の要素をイミディエイトに書き出す。
ちなみに、strの内容は、外側のForループ先頭で""に初期化される。
こいつを実行してみる。
これを見ると、「b」の下２つと「o」の右１つが「*」になっていることが分かる。
つまり、結合されたセルに含まれるセルの値を参照すると、TopLeftのセル以外は全て「""」を返しているということだ。
んで、結合されたセルをアクティブにして、イミディエイトでいくつか確認してみる。
?activecell.MergeArea.Columns.Count 1 ?activecell.MergeArea.Rows.Count 3 ?activecell.MergeCells True ?activecell.MergeArea.Count 3
要するに、
- MergeCellsプロパティがTrueで、Valueが""でないセルに当たったら、
- rowspanを「="[MergeArea.Rows.Countプロパティの値]"」にして、
- colspanを「="[MergeArea.Columns.Countプロパティの値]"」にし、
- MergeCellsプロパティがTrueで、Valueが""のセルに当たったら、
- rowspanとcolspanを「=""」にしたらよい
ということだ。
ちょいと条件が複雑だけれど、まあ簡単な方だと思う。
コードの改変
前回のリスト１を改変する。
リスト２ 標準モジュール
Public Function createHTMLTable( _
ByVal targetRange As Range, _
ByVal captionText As String, _
Optional ByVal hasHeader As Boolean = True, _
Optional ByVal hasBorder As Boolean) _
As String
Dim rowCount As Long
rowCount = targetRange.Rows.Count
Dim columnCount As Long
columnCount = targetRange.Columns.Count
Dim i As Long
Dim j As Long
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
Dim str As String
Dim rowSpan As String
Dim colSpan As String
If hasBorder Then
str = "<table border=""1"">"
Else
str = "<table border="""">"
End If
If Not IsMissing(captionText) Then _
str = str & "<caption>" & captionText & "</caption>"
For i = 1 To rowCount
str = str & "<tr>"
For j = 1 To columnCount
With targetRange.Cells(i, j) '……(1)'
If stringOfCell(i - 1, j - 1) <> "" And _
.MergeCells Then '……(2)'
rowSpan = CStr(.MergeArea.Rows.Count) '……(3)'
colSpan = CStr(.MergeArea.Columns.Count)
Else
rowSpan = "" '……(4)'
colSpan = ""
End If
End With
If hasHeader And i = 1 Then
str = str & "<th rowspan=""" & rowSpan & _
""" colspan=""" & colSpan & """>" & _
stringOfCell(i - 1, j - 1) & "</th>" '……(5)'
Else
str = str & "<td rowspan=""" & rowSpan & _
""" colspan=""" & colSpan & """>" & _
stringOfCell(i - 1, j - 1) & "</td>"
End If
Next
str = str & "</tr>"
Next
str = str & "</table>"
str = Replace(str, " rowspan=""""", "") '……(6)'
str = Replace(str, " rowspan=""1""", "")
str = Replace(str, " colspan=""""", "")
str = Replace(str, " colspan=""1""", "")
str = Replace(str, "<th></th>", "")
str = Replace(str, "<td></td>", "")
str = Replace(str, vbLf, "<br>")
createHTMLTable = str
End Function
後から機能を追加するような形になったので、ややこしくなってしまったことは堪忍してほしい。
またヒマなときにリファクタリングは必要だと思っている。
まず、(1)からの10行（実質９行）
With targetRange.Cells(i, j)
If stringOfCell(i - 1, j - 1) <> "" And _
.MergeCells Then '……(2)'
rowSpan = CStr(.MergeArea.Rows.Count) '……(3)'
colSpan = CStr(.MergeArea.Columns.Count)
Else
rowSpan = "" '……(4)'
colSpan = ""
End If
End With
では、そのセルが結合されているかどうかを調べ、さらにそのセルが値を持っていたら（つまり結合セルのTopLeftだったら）変数rowSpanとcolSpanに設定すべき値をぶち込み、値を持っていなかったら変数rowSpanとcolSpanに「""」をぶち込んでいる。
(2)の
If stringOfCell(i - 1, j - 1) <> "" And _ .MergeCells Then
の条件式がTrueになるのは、
結合されたセルであり、かつ値を持っている場合
なので、(3)の
rowSpan = CStr(.MergeArea.Rows.Count) colSpan = CStr(.MergeArea.Columns.Count)
で変数rowSpanとcolSpanに値をString型に変換してぶち込んでおく。
それ以外の場合（条件式がFalseになる場合）は、(4)の
rowSpan = "" colSpan = ""
で変数の値を「""」にしておく。
これで、たとえば
２行３列の結合セルのTopLeft（左上）のセル
に行き当たった場合は、
<td rowspan="2" colspan="3">hogehoge</td>
となれば良いし、TopLeftのセル以外ならば
<td rowspan="" colspan="">fugafuga</td>
となれば良いわけだ。
そのために、たとえば(5)の
str = str & "<th rowspan=""" & rowSpan & _
""" colspan=""" & colSpan & """>" & _
stringOfCell(i - 1, j - 1) & "</th>"
のような形で文字列を組み立てる。「"（ダブルクォーテーション）」のエスケープがあるのでちょっと分かりづらいな。
あとは(6)からの５行で仕上げ。
str = Replace(str, " rowspan=""""", "") str = Replace(str, " colspan=""""", "") str = Replace(str, "<th></th>", "") '……(*)' str = Replace(str, "<td></td>", "") str = Replace(str, vbLf, "<br>")
Replace関数を用いて、不要な文字列を削除する。
「rowspan=""」とか「colspan=""」はなくても良いわけだから、削除する。あったらむやみやたらと長くなるし。
(*)からの２行
str = Replace(str, "<th></th>", "") str = Replace(str, "<td></td>", "")
では、「<th></th>」と「<td></td>」を削除している。
これをしないと、
こんなふうになってしまう（理由は自分で考えろよう！）。
最後にセル内改行を「<br>」に置き換えるのは前回同様。
実行結果
次のコードで実行。
リスト３
Public Sub testHTMLTable()
Dim Sh As Worksheet
Set Sh = ThisWorkbook.Worksheets("Sheet2")
Debug.Print createHTMLTable(targetRange:=Sh.Range("A9").CurrentRegion, _
captionText:="ち～んｗ", _
hasHeader:=True, _
hasBorder:=True)
End Sub
イミディエイトに出力された文字列をHTMLソースに貼り付けて、ブラウザで開くと、
ほれ、この通り、うまく行った。
もうちょっとややこしい表でも実験。
しまった……。「常荷金作」だよ……。
こんな表を作って、同じように実行してみた。
こんな風になります。
おわりに
何やってんだろ、オレ……orz
