Excel VBA ワークシートをHTMLテーブル

Excel VBA

Excel VBA ワークシートをHTMLテーブル

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