Excelシート内に作成したボタンにVBAプログラムを記述します。
ボタン1_Click 以下をコピーして、
ボタンに貼り付けて実行してみて下さい。
処理の基本的な流れですが、
ボタンを押すと、、
シートを１行ずつ読んで、
HTMLタグを出力していきます。
Excelで扱う文字コードは Shift-JISなので、
最終的にUTF-8（BOMなし）形式にして、c:\temp\table.html という名前でファイルを作成します。
なお、Excelファイルは、
マクロ有効ブック *.xlsm 形式で保存します。
プログラムさえ組んでしまえば、
面倒なタグを扱うことなしに、
HTMLファイルの更新を行うことができます。
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub ボタン1_Click()
' 変数定義
Dim FileName ' 出力ファイル名
Dim xRow ' 行位置
Dim kdate, kkukan, kunchin ' ワークエリア
Dim OutText ' 出力バッファ
' PC版
xRow = 2
OutText = ""
' HTML（ヘッダ部）の出力
OutText = OutText & "<html>" & vbCrLf
OutText = OutText & "<head>" & vbCrLf
OutText = OutText & "<meta http-equiv=""Content-Type"" content=""text/html; charset=UTF-8"">" & vbCrLf
OutText = OutText & "</head>" & vbCrLf
OutText = OutText & "<body>" & vbCrLf
' Tableタグ（開始）の出力
OutText = OutText & "<table border=""1"">" & vbCrLf
OutText = OutText & "<tbody>" & vbCrLf
OutText = OutText & "<tr>" & vbCrLf
OutText = OutText & "<td>日付</td>" & vbCrLf
OutText = OutText & "<td>区間</td>" & vbCrLf
OutText = OutText & "<td>運賃</td>" & vbCrLf
OutText = OutText & "</tr>" & vbCrLf
' 一行ずつ処理をしていく
Do While Range("A" & xRow).Value <> "" ' A列に何も入力されていないければ終了とする
kdate = Range("A" & xRow) ' 日付（A列）保存
kkukan = Range("B" & xRow) ' 区間（B列）保存
kunchin = Range("C" & xRow) ' 運賃（C列）保存
' 出力バッファに保存
OutText = OutText & "<tr>"
OutText = OutText & "<td>" & kdate & "</td>"
OutText = OutText & "<td>" & kkukan & "</td>"
OutText = OutText & "<td>" & kunchin & "</td>"
OutText = OutText & "</tr>" & vbCrLf
xRow = xRow + 1
Loop
' Tableタグ（終了）の出力
OutText = OutText & "</tbody>" & vbCrLf
OutText = OutText & "</table>" & vbCrLf
' HTML（降った部）の出力
OutText = OutText & "</body>" & vbCrLf
OutText = OutText & "</html>" & vbCrLf
' ファイルの出力先
FileName = "c:\temp\table.html"
'ADODBの設定
' 参照設定 ［ツール］→［参照設定］で
' Microsoft ActiveX Data Objects x.x Library にチェックを入れる
Dim ado1 As New ADODB.Stream
' UTF-8形式のファイルで保存する
ado1.Type = adTypeText
ado1.Charset = "UTF-8"
ado1.LineSeparator = adCRLF
ado1.Open
ado1.WriteText OutText, adWriteLine
ado1.SaveToFile FileName, adSaveCreateOverWrite
ado1.Close
Dim Src, BOM, Buf
' UTF8 BOMの削除
Set Src = CreateObject("ADODB.Stream")
Src.Open
Src.Type = adTypeText
Src.Charset = "utf-8"
Src.WriteText ""
Src.Position = 0
Src.Type = adTypeBinary
BOM = CStr(Src.Read(3))
Src.LoadFromFile FileName
Buf = CStr(Src.Read(3))
If Buf = BOM Then
Buf = Src.Read(-1)
Src.Position = 0
Src.Write Buf
Src.SetEOS
Src.SaveToFile FileName, adSaveCreateOverWrite
End If
Src.Close
Set Src = Nothing
MsgBox "終了しました"
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
｡:+* ﾟ ゜ﾟ *+:｡:+* ﾟ ゜ﾟ *+:｡:+* ﾟ ゜ﾟ *+:｡:+* ﾟ ゜ﾟ *+:｡:+* ﾟ ゜ﾟ *+:｡
株式会社ティリオンは、
システムに強いＷＥＢ制作会社、
魅せるホームページ＋高度なシステムで、
ビジネスの成功をお手伝いします。
システムに強いＷＥＢ制作会社、
魅せるホームページ＋高度なシステムで、
ビジネスの成功をお手伝いします。
こんなことできないか、と、思ったら、
まずは、お気軽にお問合せを、
miura@tirion.co.jp 担当：三浦
弊社では、お酒の情報ポータルサイト、
銘酒ネット（http://meisyu.net/）を運営しています。
銘酒ネット（http://meisyu.net/）を運営しています。
｡:+* ﾟ ゜ﾟ *+:｡:+* ﾟ ゜ﾟ *+:｡:+* ﾟ ゜ﾟ *+:｡:+* ﾟ ゜ﾟ *+:｡:+* ﾟ ゜ﾟ *+:｡
