Sub
ExcelTableToHTMLTable()
Dim ws As Worksheet
Dim rng As Range
Dim i 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 टिप्पणियाँ
Please do not enter any spam link in the comment box.