Option Explicit
Const TRstag As String = "", TRetag As String = "
", _
THstag As String = "", THetag As String = " | "
Const TDstago As String = ""
Print #1, ""
Print #1, ""
Print #1, ""
Print #1, "" & TableName & ""
Print #1, ""
Print #1, ""
Print #1, ""
Print #1, "" & TableName & ""
Print #1, TRstag; '一行目用意
For c = 1 To colmax '一行目をTHにします
Print #1, THstag; EscMkUps(Cells(1, c).Value); THetag;
Next
Print #1, TRetag
For rn = 2 To rowmax '二行目以下の一列目をTHにします
Print #1, TRstag; THstag; EscMkUps(Cells(rn, 1).Value); THetag;
For cn = 2 To colmax '二行目以下の二列目以下をTDにします
Print #1, TDstago;
Select Case Cells(rn, cn).HorizontalAlignment
Case xlCenter '横位置指定を取得してTDに入れます
Print #1, Spc(1); "align=""center""";
Case xlRight
Print #1, Spc(1); "align=""right""";
End Select
Print #1, tagc; EscMkUps(Cells(rn, cn).Value); TDetag;
Next
Print #1, TRetag
Next
Print #1, "
"
Print #1, ""
Print #1, "";
MsgBox "HTML形式のファイル" & file_name & "を作成しました。", _
vbOKOnly, "変換終了"
Close #1
End Sub
Function EscMkUps(cont As String) As String
cont = Application.Substitute(cont, amp, neamp)
cont = Application.Substitute(cont, lt, nelt)
cont = Application.Substitute(cont, gt, negt)
cont = Application.Substitute(cont, quot, nequot)
EscMkUps = cont
End Function