Create HTML Table from Excel Table

Sub ExcelTableToHTMLTable()
    Dim ws As Worksheet
    Dim rng As Range
    Dim As integer, j as integer
    Dim txtFilePath As String
    Dim txtFileNumber As Integer
    Dim rowDataH As String, rowDataB As String, thStart1 As String,
thStart2 As String, thEnd1 As String,thEnd2 As String
    Dim tbStart1 As String, tbStart2 As String,tbStart3 As String, tbEnd1 As String,tbEnd2 As String,tbEnd3 As String

    'Set the worksheet you want to export from
    Set ws = ThisWorkbook.Sheets("Sheet1") 'Change "Sheet1" to your sheet name

    'Define the path to the text file
    txtFilePath = Application.GetSaveAsFilename( _
                        InitialFileName:="ExportedData.txt", _
                        FileFilter:="Text Files (*.txt), *.txt")

    If txtFilePath = "False" Then Exit Sub 'User cancelled the file dialog

    'Get a free file number
    txtFileNumber = FreeFile

    'Open the text file for output
    Open txtFilePath For Output As txtFileNumber

        'HTML code for table header
        thStart1 = "<div>" & vbNewLine & "<table align=""center"" style=""width: 50%;"">" & vbNewLine & "<thead>" & vbNewLine & "<tr>" & vbNewLine & "<th style=""background-color: #cccccc;"">"
        thStart2 = "<th style=""background-color: #cccccc;"">"
        thEnd1 = "</th>"
        thEnd2 = "</th>" & vbNewLine & "</tr>" & vbNewLine & "</thead>" & vbNewLine & "<tbody>"

        ' Loop through each cell for the table header
        For i = 1 To WorksheetFunction.CountA(Range("1:1"))
            If i = 1 Then
                rowDataH = thStart1 & Cells(1, i).Value & thEnd1
            ElseIf i = WorksheetFunction.CountA(Range("1:1")) Then
                rowDataH = thStart2 & Cells(1, i).Value & thEnd2
            Else
                rowDataH = thStart2 & Cells(1, i).Value & thEnd1
            End If
            Print #txtFileNumber, rowDataH
        Next i

        'HTML code for table body
        tbStart1 = "<tr style=""background-color: #f2f2f2;"">" & vbNewLine & "<td>"
        tbStart2 = "<tr style=""background-color: white;"">" & vbNewLine & "<td>"
        tbStart3 = "<td>"
        tbEnd1 = "</td>"
        tbEnd2 = "</td>" & vbNewLine & "</tr>"
        tbEnd3 = "</td>" & vbNewLine & "</tr>" & vbNewLine & "</tbody>" & vbNewLine & "</table>" & vbNewLine & "</div>"

        ' Loop through each cell for the table body
        For j = 2 To WorksheetFunction.CountA(Range("A:A"))
            For i = 1 To WorksheetFunction.CountA(Range("1:1"))
                If j Mod 2 = 0 Then
                    If i = 1 Then
                        rowDataB = tbStart1 & Cells(j, i).Value & tbEnd1
                    ElseIf i = WorksheetFunction.CountA(Range("1:1")) And j = WorksheetFunction.CountA(Range("A:A")) Then
                        rowDataB = tbStart3 & Cells(j, i).Value & tbEnd3
                    ElseIf i = WorksheetFunction.CountA(Range("1:1")) Then
                        rowDataB = tbStart3 & Cells(j, i).Value & tbEnd2
                    Else
                        rowDataB = tbStart3 & Cells(j, i).Value & tbEnd1
                    End If

                Else

                    If i = 1 Then
                        rowDataB = tbStart2 & Cells(j, i).Value & tbEnd1
                    ElseIf i = WorksheetFunction.CountA(Range("1:1")) And j = WorksheetFunction.CountA(Range("A:A")) Then
                        rowDataB = tbStart3 & Cells(j, i).Value & tbEnd3
                    ElseIf i = WorksheetFunction.CountA(Range("1:1")) Then
                        rowDataB = tbStart3 & Cells(j, i).Value & tbEnd2
                    Else
                        rowDataB = tbStart3 & Cells(j, i).Value & tbEnd1
                    End If
                End If
                'print each line into text file
                Print #txtFileNumber, rowDataB
            Next i
        Next j      

    ' Close the text file
    Close txtFileNumber

    MsgBox "HTML created successfully to " & txtFilePath

End Sub


एक टिप्पणी भेजें

0 टिप्पणियाँ