Excelを開いて表を見るのは面倒だったりする。
（Excelの起動を待ったり、別作業でExcelを使っていたりするとき）
そんなときブラウザで表形式データが見れたら便利だ、というモチベーションでExcelで作成したテーブルをHTMLに変換するプログラムを作ってみた。
Excel の準備
こんな感じでExcelを準備。セル色：グレーに設定情報、白に実データが入ります。
* 3行目：HTMLタイトル入力。
* 5行目：Table対象にする列に「1」を設定し、該当列のみHTMLに出力。
* 6行目：aタグ用にURLを入力した列の番号を指定。例だと7列目にPDFのURLを指定。
* 7行目：imgタグ用にURLを入力した列の番号を指定。例だと8列目にjpegファイルのURLを指定。
* 8行目：当該列の列幅を指定。
* 9行目：ヘッダー名を入力。
* 10行目以降：実データを入力。
VBAコード
このエクセルに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 '--------------------------------------- ' HTMLテーブル生成 '--------------------------------------- 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） - こちにぃるの日記
