Excelを開いて表を見るのは面倒だったりする。
（Excelの起動を待ったり、別作業でExcelを使っていたりするとき）
そんなときブラウザで表形式データが見れたら便利だ、というモチベーションでExcelで作成したテーブルをHTMLに変換するプログラムを作ってみた。
こんな感じでExcelを準備。セル色：グレーに設定情報、白に実データが入ります。
* 3行目：HTMLタイトル入力。
* 5行目：Table対象にする列に「1」を設定し、該当列のみHTMLに出力。
* 6行目：aタグ用にURLを入力した列の番号を指定。例だと7列目にPDFのURLを指定。
* 7行目：imgタグ用にURLを入力した列の番号を指定。例だと8列目にjpegファイルのURLを指定。
* 8行目：当該列の列幅を指定。
* 9行目：ヘッダー名を入力。
* 10行目以降：実データを入力。
このエクセルにHTML生成用のVBAコードを仕込む。
Option Explicit
Sub CreateHTMLTable()
On Error GoTo ERROR1
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim myWB As Workbook, myWS As Worksheet
Dim strow, enrow, stcol, encol, t_row, a_row, i_row, w_row, h_row, r, c As Long
Dim outfile As String
Dim adoSt As Object
Set adoSt = CreateObject("ADODB.Stream")
Const adTypeBinary = 1
Const adTypeText = 2
Const adCR = 13
Const adLF = 10
Const adCRLF = -1
Const adWriteChar = 0
Const adWriteLine = 1
Const adSaveCreateNotExist = 1
Const adSaveCreateOverWrite = 2
Set myWB = ThisWorkbook
Set myWS = myWB.Sheets(ActiveSheet.Name)
t_row = 5
a_row = 6
i_row = 7
w_row = 8
h_row = 9
strow = 10
enrow = myWS.UsedRange.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
stcol = 2
encol = myWS.UsedRange.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
outfile = Replace(myWS.Cells(3, 2), "\", "_")
outfile = Replace(outfile, "/", "_")
outfile = Replace(outfile, ":", "_")
outfile = Replace(outfile, "*", "_")
outfile = Replace(outfile, "?", "_")
outfile = Replace(outfile, """", "_")
outfile = Replace(outfile, "<", "_")
outfile = Replace(outfile, ">", "_")
outfile = Replace(outfile, "|", "_")
outfile = Replace(outfile, " ", "_")
outfile = Replace(outfile, " ", "_")
With adoSt
.Charset = "UTF-8"
.Type = adTypeText
.LineSeparator = adLF
.Open
.WriteText "<!DOCTYPE html>", adWriteLine
.WriteText "<html lang='ja'>", adWriteLine
.WriteText "<head>", adWriteLine
.WriteText " <meta charset='utf8'>", adWriteLine
.WriteText " <title>SampleHTMLtable</title>", adWriteLine
.WriteText " <!-- Bootstrap -->", adWriteLine
.WriteText " <link rel='stylesheet' href='https://stackpath.bootstrapcdn.com/bootstrap/4.3.1/css/bootstrap.min.css' integrity='sha384-ggOyR0iXCbMQv3Xipma34MD+dH/1fQ784/j6cY/iJTQUOhcWr7x9JvoRxT2MZw1T' crossorigin='anonymous'>", adWriteLine
.WriteText " ", adWriteLine
.WriteText " <!-- jQuery -->", adWriteLine
.WriteText " <script type='text/javascript' src='https://ajax.googleapis.com/ajax/libs/jquery/3.6.0/jquery.min.js'></script>", adWriteLine
.WriteText " ", adWriteLine
.WriteText " <!-- Datatables -->", adWriteLine
.WriteText " <link rel='stylesheet' href='https://cdn.datatables.net/t/bs-3.3.6/jqc-1.12.0,dt-1.10.11/datatables.min.css'/> ", adWriteLine
.WriteText " <script src='https://cdn.datatables.net/t/bs-3.3.6/jqc-1.12.0,dt-1.10.11/datatables.min.js'></script>", adWriteLine
.WriteText " <script type='text/javascript'>", adWriteLine
.WriteText " jQuery(function($){", adWriteLine
.WriteText " $.extend( $.fn.dataTable.defaults, {", adWriteLine
.WriteText " language: {", adWriteLine
.WriteText " url: 'http://cdn.datatables.net/plug-ins/9dcbecd42ad/i18n/Japanese.json'", adWriteLine
.WriteText " } ", adWriteLine
.WriteText " }); ", adWriteLine
.WriteText " $('#TableLayout1').DataTable({", adWriteLine
.WriteText " scrollX: true", adWriteLine
.WriteText " ,scrollY: '75vh'", adWriteLine
.WriteText " ,displayLength: 10", adWriteLine
.WriteText " });", adWriteLine
.WriteText " });", adWriteLine
.WriteText " </script>", adWriteLine
.WriteText "</head>", adWriteLine
.WriteText "<body>", adWriteLine
.WriteText " <table id='TableLayout1' border='1'>", adWriteLine
.WriteText " <thead style='background-color: #64F9C1;'>", adWriteLine
.WriteText " <tr>", adWriteLine
For c = stcol To encol
If myWS.Cells(t_row, c) = 1 Then
.WriteText " <th width='" & myWS.Cells(w_row, c) & "px'>" & EscapeTxt(myWS.Cells(h_row, c)) & "</th>", adWriteLine
End If
Next c
.WriteText " </tr>", adWriteLine
.WriteText " </thead>", adWriteLine
.WriteText " <tbody>", adWriteLine
For r = strow To enrow
.WriteText " <tr>", adWriteLine
For c = stcol To encol
If myWS.Cells(t_row, c) = 1 Then
If myWS.Cells(a_row, c) <> "" Then
If myWS.Cells(r, myWS.Cells(a_row, c)) <> "" Then
.WriteText " <td><a target='_blank' href='" & myWS.Cells(r, myWS.Cells(a_row, c)) & "'>" & EscapeTxt(myWS.Cells(r, c)) & "</a></td>", adWriteLine
Else
.WriteText " <td>" & EscapeTxt(myWS.Cells(r, c)) & "</td>", adWriteLine
End If
ElseIf myWS.Cells(i_row, c) <> "" Then
If myWS.Cells(r, myWS.Cells(i_row, c)) <> "" Then
.WriteText " <td><img src='" & myWS.Cells(r, myWS.Cells(i_row, c)) & "' title='" & EscapeTxt(myWS.Cells(r, c)) & "' width='" & myWS.Cells(w_row, c) & "px'></td>", adWriteLine
Else
.WriteText " <td>" & EscapeTxt(myWS.Cells(r, c)) & "</td>", adWriteLine
End If
Else
.WriteText " <td>" & EscapeTxt(myWS.Cells(r, c)) & "</td>", adWriteLine
End If
End If
Next c
.WriteText " </tr>", adWriteLine
Next r
.WriteText " </tbody>", adWriteLine
.WriteText " </table>", adWriteLine
.WriteText "</body>", adWriteLine
.WriteText "</html>", adWriteLine
.SaveToFile ThisWorkbook.Path & "\" & outfile & ".html", adSaveCreateOverWrite
.Close
End With
myWS.Cells(1, 1).Select
MsgBox "出力しました"
GoTo END1
ERROR1:
MsgBox Err.Number & ":" & Err.Description
END1:
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set adoSt = Nothing
Set myWB = Nothing
Set myWS = Nothing
End Sub
Function EscapeTxt(InTxt As String) As String
EscapeTxt = Replace(InTxt, "&", "&")
EscapeTxt = Replace(EscapeTxt, "<", "<")
EscapeTxt = Replace(EscapeTxt, ">", ">")
EscapeTxt = Replace(EscapeTxt, "'", "'")
EscapeTxt = Replace(EscapeTxt, """", """)
EscapeTxt = Replace(EscapeTxt, " ", " ")
EscapeTxt = Replace(EscapeTxt, vbNewLine, "<br/>")
EscapeTxt = Replace(EscapeTxt, vbCrLf, "<br/>")
EscapeTxt = Replace(EscapeTxt, vbCr, "<br/>")
EscapeTxt = Replace(EscapeTxt, vbLf, "<br/>")
End Function
HTMLは、Stream オブジェクト（ ADODB.Stream ）を使って UTF 形式で出力している。
Stream オブジェクト (ADO) - ActiveX Data Objects (ADO) | Microsoft Docs
Stream オブジェクトのプロパティ、メソッド、およびイベント - ActiveX Data Objects (ADO) | Microsoft Docs
また、HTMLテーブルにソート・フィルター機能等を付けたかったので DataTables を使用している。
DataTables を初めて使ったが、実装は簡単で見栄えも良い。表の幅とか高さとかは使う環境で微調整が必要。
DataTables | Table plug-in for jQuery
Options
HTMLファイルを生成
表に値を入れて、HTMLファイルを生成してみるとこんな感じ。
PDFのリンクも開け、画像も表示され、最低限の機能は揃えられたかな？
一元管理ができそうで、何より何より。
今回作ったHTMLテーブルを別のHTMLファイルに埋め込む方法は以下の記事で。
【HTML】別HTMLを埋め込む（iframe） - こちにぃるの日記
