12,673
回編集
差分
ナビゲーションに移動
検索に移動
ページの作成:「Excel VBA ==Excel VBA ワークシートをHTMLテーブル== <pre> Option Explicit Public Function MakeHtmlTable(table As Range) As String Dim buf As String…」
[[Excel VBA]]
==Excel VBA ワークシートをHTMLテーブル==
<pre>
Option Explicit
Public Function MakeHtmlTable(table As Range) As String
Dim buf As String
Dim cl As Range
Dim rowPos As Integer
Dim isFirstRow As Boolean
Dim celVal As String
isFirstRow = True
rowPos = -1
buf = "<table border=""1"">"
For Each cl In table
If rowPos <> cl.row Then
If Not isFirstRow Then
buf = buf & "</tr>"
End If
buf = buf & "<tr>"
isFirstRow = False
End If
celVal = EscapeHtmlSpecial(cl.text)
If Trim(celVal) = "" Then
celVal = " "
End If
rowPos = cl.row
buf = buf & "<td>" & celVal & "</td>"
Next
buf = buf & "</table>"
MakeHtmlTable = buf
End Function
Public Function EscapeHtmlSpecial(text As String) As String
Dim buf As String
Dim c As String
Dim i As Integer
For i = 1 To Len(text)
c = Mid(text, i, 1)
Select Case c
Case "&"
c = "&"
Case "<"
c = "<"
Case ">"
c = ">"
Case """"
c = "'""
End Select
buf = buf & c
Next
EscapeHtmlSpecial = buf
End Function
</pre>
==Excel VBA ワークシートをHTMLテーブル==
<pre>
Option Explicit
Public Function MakeHtmlTable(table As Range) As String
Dim buf As String
Dim cl As Range
Dim rowPos As Integer
Dim isFirstRow As Boolean
Dim celVal As String
isFirstRow = True
rowPos = -1
buf = "<table border=""1"">"
For Each cl In table
If rowPos <> cl.row Then
If Not isFirstRow Then
buf = buf & "</tr>"
End If
buf = buf & "<tr>"
isFirstRow = False
End If
celVal = EscapeHtmlSpecial(cl.text)
If Trim(celVal) = "" Then
celVal = " "
End If
rowPos = cl.row
buf = buf & "<td>" & celVal & "</td>"
Next
buf = buf & "</table>"
MakeHtmlTable = buf
End Function
Public Function EscapeHtmlSpecial(text As String) As String
Dim buf As String
Dim c As String
Dim i As Integer
For i = 1 To Len(text)
c = Mid(text, i, 1)
Select Case c
Case "&"
c = "&"
Case "<"
c = "<"
Case ">"
c = ">"
Case """"
c = "'""
End Select
buf = buf & c
Next
EscapeHtmlSpecial = buf
End Function
</pre>
© 2006 矢木浩人
