12,673
回編集
差分
ナビゲーションに移動
検索に移動
→Excel VBA ワークシートをHTMLテーブル
[[Excel VBA]]
==Excel VBA ワークシートをHTMLテーブル==
<pre>Option Explicit Public Function MakeHtmlTable(table As Range, headerType As String, headerSize As Integer, cls As String) As String
Dim buf As String
Dim cl As Range
Dim isFirstRow As Boolean
Dim celVal As String
Dim colPos As Integer
Dim isColHeader As Boolean
Dim isRowHeader As Boolean
Dim celTag As String
If Trim(cls) <> "" Then
cls = " class=""" & cls & """ "
Else
cls = " border=""1"" "
End If
isColHeader = InStr(headerType, "c") > 0
isRowHeader = InStr(headerType, "r") > 0
isFirstRow = True
rowPos = -1
buf = "<table border=""1"& cls & ">"
For Each cl In table
If rowPos <> cl.row Row Then
If Not isFirstRow Then
buf = buf & "</tr>"
buf = buf & "<tr>"
isFirstRow = False
colPos = 0
End If
celVal = EscapeHtmlSpecial(cl.text)
If Trim(celVal) = "" Then
celVal = " "
End If
rowPos = cl.rowRow buf If (isColHeader And headerSize > colPos) Or _ (isRowHeader And headerSize > rowPos) Then celTag = "th" Else celTag = buf & "<td>" End If buf = buf & EncloseTag(celVal & "</td>", celTag) colPos = colPos + 1
Next
buf = buf & "</table>"
MakeHtmlTable = buf
End FunctionPublic Function EncloseTag(value As String, tag As String) EncloseTag = "<" & tag & ">" & value & "</" & tag & ">"
End Function
Public Function EscapeHtmlSpecial(text As String) As String
Dim buf As String
Select Case c
Case "&"
c = "&"
Case "<"
c = "<<"
Case ">"
c = ">>"
Case """"
c = "'""""
End Select
© 2006 矢木浩人
