■ はじめに
* Excelマクロで簡単にHTML化はできるが 余計なタグやら情報が含まれるので、 独自でHTML化できるようなツールを作ってみる * 以下の関連記事を応用してできる。
Excel マクロ ～ ファイル出力 / UTF-8 ～
https://dk521123.hatenablog.com/entry/2015/07/17/195527
■ サンプル
Sub ボタン1_Click()
' 定数
Const MaxRow As Integer = 5000
Const MaxColumn As Integer = 5000
Dim sheet As Worksheet
Set sheet = Worksheets("Sheet1")
fileName = "test.html"
Dim html As String: html = ""
html = html & "<html>" & vbCrLf
html = html & "<body>" & vbCrLf
' ***** テーブル作成 *****
html = html & "<table>" & vbCrLf
' ===== テーブルの項目 =====
' 項目数
Dim itemNumber As Integer: itemNumber = 0
html = html & "<tr>" & vbCrLf
' テーブルの項目
For i = 1 To MaxRow
If IsEmpty(sheet.Cells(1, i).Value) = True Then
' 値がない時は処理を中断
Exit For
End If
html = html & "<th>"
html = html & sheet.Cells(1, i).Value
html = html & "</th>" & vbCrLf
itemNumber = itemNumber + 1
Next
html = html & "</tr>" & vbCrLf
' ===== テーブルの内容 =====
For i = 2 To MaxColumn
' ここは、それぞれの仕様で実装する必要がある
If IsEmpty(sheet.Cells(i, 1).Value) = True Then
' 初めに値がない時は処理を中断
Exit For
End If
html = html & "<tr>" & vbCrLf
For j = 1 To itemNumber
html = html & "<td>"
html = html & sheet.Cells(i, j).Value
html = html & "</td>" & vbCrLf
Next
html = html & "</tr>" & vbCrLf
Next
html = html & "</table>" & vbCrLf
html = html & "</body>" & vbCrLf
html = html & "</html>" & vbCrLf
If SaveFileWithUtf8(html, fileName) = False Then
MsgBox "ファイルの作成に失敗しました", vbCritical & vbOKOnly, "エラー"
End If
End Sub
Public Function SaveFileWithUtf8(ByVal inputData As String, ByVal fileName As String) As Boolean
On Error GoTo ErrorHandler
Dim isSuccessful As Boolean: isSuccessful = False
' 定数
Const AdodbTypeBinary As Integer = 1
Const AdodbTypeText As Integer = 2
Const AdodbSaveCreateOverWrite As Integer = 2
Const FileCharset As String = "UTF-8"
' ADODB.Streamを作成
Dim sourceOfDataStream: Set sourceOfDataStream = CreateObject("ADODB.Stream")
' 最初はテキストモードでUTF-8で書き込む
sourceOfDataStream.Type = AdodbTypeText
sourceOfDataStream.Charset = FileCharset
sourceOfDataStream.Open
' ファイルに書き込み
sourceOfDataStream.WriteText (inputData), 1
' バイナリモードにするためにPositionを0に戻す
' Readするためにはバイナリタイプでないといけない
sourceOfDataStream.Position = 0
sourceOfDataStream.Type = AdodbTypeBinary
' Positionを3にしてから読み込むことで最初の3バイトをスキップする
' UTF-8(BOMあり)のBOMをスキップします
sourceOfDataStream.Position = 3
Dim binaryOutputData: binaryOutputData = sourceOfDataStream.Read()
' 読み込んだバイナリデータをバイナリデータとしてファイルに出力する
Dim outputStream: Set outputStream = CreateObject("ADODB.Stream")
outputStream.Type = AdodbTypeBinary
outputStream.Open
outputStream.Write (binaryOutputData)
outputStream.SaveToFile fileName, AdodbSaveCreateOverWrite
isSuccessful = True
GoTo Finally
ErrorHandler:
MsgBox Err.Number & ":" & Err.Description, vbCritical & vbOKOnly, "エラー"
isSuccessful = False
Finally:
'ストリームの後始末
If Not outputStream Is Nothing Then
outputStream.Close
End If
If Not sourceOfDataStream Is Nothing Then
sourceOfDataStream.Close
End If
SaveFileWithUtf8 = isSuccessful
End Function
入力データ : シート「Sheet1」
id name age 1 mike 23 2 Tom 32
出力結果 : test.html
<html> <body> <table> <tr> <th>id</th> <th>name</th> <th>age</th> </tr> <tr> <td>1</td> <td>mike</td> <td>23</td> </tr> <tr> <td>2</td> <td>Tom</td> <td>32</td> </tr> </table> </body> </html>
関連記事
Excel マクロ ～ 入門編 ～
https://dk521123.hatenablog.com/entry/2015/07/15/104500
Excel マクロ ～ ファイル出力 / UTF-8 ～
https://dk521123.hatenablog.com/entry/2015/07/17/195527
