Here’s the VBA code for the macro “TableToHTML” plus installation instructions.
This will allow you to select an Excel table and paste it into WordPress as an HTML table.
HOW TO INSTALL
1) Place the below code into a VBA module and save the Workbook as “Table To HTML.xlsm”.
2) Next save the WB as an Excel Add-in.
3) Close the file and open a new workbook.
4) If you don’t have the [Developer] entry on the ribbon select [File] > [Options] > [Customize Ribbon]. Then under “Main Tabs” scroll down and tick “Developer” then click [OK].
5) From the ribbon select [Developer] > [Excel Add-ins] then tick “Table-To-HTML”
6) Select [File] > [Options] > [Quick Access Toolbar]. Under “Choose commands From” select “Macros” then select “TableToHTML, click [Add >>] then [OK]
HOW TO USE
1) Select the table in your Excel Workbook. Only one rectangular table can be selected.
2) Click [TableToHTML] on your newly created Quick Access Toolbar. The selected area is now converted to HTML and placed on the clipboard.
3) Note the message at the bottom left of the screen which will be one of:
“hh:mm:ss: Cells XX9:YY9 copied to clipboard as an HTML table”
optionally followed by “xx rows copied, yy rows omitted”
and/or “zz columns omitted”
4) In WordPress create a Custom HTML block and paste the contents of the clipboard. The table will contain a horizontal scrollbar if too large for the page.
VBA CODE
Sub Table_To_HTML()
Dim bEmptySelection As Boolean
Dim lRowPtr As Long
Dim lColPtr As Long
Dim lEndRow As Long
Dim lEndCol As Long
Dim lSkippedRows As Long
Dim lIncludedRows As Long
Dim lSkippedCols As Long
Dim rData As Range
Dim rCur As Range
Dim sCurTag1 As String
Dim sCurTag2 As String
Dim sCurValue As String
Dim sHTML As String
Dim sMessage As String
Dim sMessIR As String
Dim sMessSR As String
Dim sMessSC As String
Dim vReply As Variant
Dim WS As Worksheet
Application.StatusBar = False
sCurTag1 = "<th>"
sCurTag2 = "</th>"
sMessIR = "s"
sMessSR = "s"
sMessSC = "s"
sHTML = "<div style='overflow-x:auto;'><table> "
Set rData = Intersect(Application.Selection, ActiveSheet.UsedRange)
If rData Is Nothing Then
MsgBox prompt:="ERROR: No data selected!", Buttons:=vbOKOnly + vbCritical
Exit Sub
End If
If rData.Areas.Count > 1 Then
MsgBox prompt:="ERROR: Only one rectangular area can be selected", Buttons:=vbOKOnly + vbCritical
Exit Sub
End If
bEmptySelection = True
lSkippedRows = 0
lIncludedRows = 0
lSkippedCols = 0
For lRowPtr = 0 To rData.Rows.Count - 1
lEndCol = rData.Columns.Count - 1
For lColPtr = 0 To lEndCol
Set rCur = rData.Resize(1, 1).Offset(lRowPtr, lColPtr)
If rCur.RowHeight > 0 Then
If lColPtr = 0 Then
sHTML = sHTML & "<tr>"
lIncludedRows = lIncludedRows + 1
End If
If rCur.ColumnWidth > 0 Then
sCurValue = CStr(rCur.Text)
If (Trim$(sCurValue)) <> "" Then
bEmptySelection = False
End If
sHTML = sHTML & sCurTag1 & HTMLSpecialChars(sCurValue) & sCurTag2
Else
If lRowPtr = 0 Then
lSkippedCols = lSkippedCols + 1
End If
End If
If lColPtr = lEndCol Then
sHTML = sHTML & "</tr>" & vbCrLf
End If
Else
If lColPtr = 0 Then
lSkippedRows = lSkippedRows + 1
End If
End If
Next lColPtr
sCurTag1 = "<td>"
sCurTag2 = "</td>"
Next lRowPtr
sHTML = sHTML & "</table></div>"
Clipboard sHTML
If bEmptySelection Then
MsgBox prompt:="ERROR: Your have not selected any data!", Buttons:=vbOKOnly + vbCritical
Exit Sub
End If
sMessage = Format(Now(), "hh:mm:ss") & ": Cells " & rData.Address(False, False) & " copied to clipboard as an HTML table"
If lSkippedRows > 0 Then
If lSkippedRows = 1 Then sMessSR = ""
If lIncludedRows = 1 Then sMessIR = ""
sMessage = sMessage & " " & lIncludedRows & " row" & sMessIR & " copied, " & lSkippedRows & " row" & sMessSR & " omitted"
End If
If lSkippedCols > 0 Then
If lSkippedCols = 1 Then sMessSC = ""
sMessage = sMessage & ", " & lSkippedCols & " column" & sMessSC & " omitted"
End If
Application.StatusBar = sMessage
If rData.Rows.Count < 2 Then
MsgBox prompt:="WARNING: Only 1 row selected!", Buttons:=vbOKOnly + vbExclamation
End If
End Sub
Private Function Clipboard$(Optional s$)
'https://stackoverflow.com/questions/14219455/excel-vba-code-to-copy-a-specific-string-to-clipboard
Dim v: v = s 'Cast to variant for 64-bit VBA support
With CreateObject("htmlfile")
With .parentWindow.clipboardData
Select Case True
Case Len(s): .setData "text", v
Case Else: Clipboard = .GetData("text")
End Select
End With
End With
End Function
Private Function HTMLSpecialChars(ByVal InputString As String) As String
Dim lPtr As Long
Dim sResult As String
Dim vaFromString As Variant
Dim vaToString As Variant
vaFromString = Array("&", Chr(34), "'", "<", ">")
vaToString = Array("&", """, "'", "<", ">")
sResult = InputString
For lPtr = LBound(vaFromString) To UBound(vaFromString)
sResult = Replace(sResult, vaFromString(lPtr), vaToString(lPtr))
Next lPtr
HTMLSpecialChars = sResult
End Function
