Excel 到 HTML 宏
4.92/5 (9投票s)
2006年8月24日
3分钟阅读
130647
2432
一个简单的宏，可以将您的Excel数据转换为干净的HTML表格。
引言
此宏旨在获取Excel电子表格中突出显示的单元格，并创建一个简单的HTML表格来显示输出。
背景
我出于工作需要编写了这个宏，因为我找不到能够完成我所需功能的代码。我的方法与其他Excel转HTML转换器不同的地方在于，许多其他转换器试图使生成的网页尽可能地像电子表格一样。我希望这个宏能够轻松创建看起来像是属于我的网站而不是MS Office的网页。
对我来说，这意味着它足够灵活，可以插入我的样式表信息和其他属性，并且不包含Microsoft喜欢放在其页面中的垃圾HTML。此外，我只关心单元格的输出，而不关心生成文本的任何底层公式。换句话说，我想要简单、干净、静态的HTML。
使用代码
有几种方法可以安装代码。最简单的方法是将其复制到C:\Documents and Settings\<USER>\Application Data\Microsoft\Excel\XLSTART目录。这将使宏在每次打开Excel时都可用，只需单击“工具”>“宏”>“宏”，然后选择exportHTML宏即可。更好的方法是将它转换为一个加载项，然后将宏分配给一个自定义按钮。请访问Microsoft网站，了解如何在您的Office版本中执行此操作。
基本思想是，宏会根据所选单元格编写一段HTML字符串。通过表单进行的任何用户输入都会合并到HTML中。插入到行或列中的任何样式信息都将插入到脚本生成的每一行或每一列中。此外，默认行为是将HTML复制到剪贴板。您可以通过转到“选项”选项卡并选择文件来将HTML写入文件。这将覆盖该文件。
这是代码。在查看表单及其属性时，它会更有意义。
Private Sub cellWidth_Change()
If cellWidth.Value = True Then table100pct.Value = False
End Sub
Private Sub findFile_Click()
' Requires reference to Microsoft Office 11.0 Object Library.
Dim fDialog As Office.FileDialog
Dim varFile As Variant
' Clear listbox contents.
'Me.FileList.RowSource = ""
' Set up the File Dialog.
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
'Do not allow user to make multiple selections in dialog box
.AllowMultiSelect = False
' Set the title of the dialog box.
.Title = "Please select a file"
' Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add "All Files", "*.*"
.Filters.Add "ASP files", "*.asp"
.Filters.Add ".Net files", "*.aspx"
.Filters.Add "Html files", "*.htm, *.html"
' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
'Loop through each file selected and add it to our list box.
For Each varFile In .SelectedItems
filePath.Text = varFile
Next
'MsgBox .SelectedItems.Item(0)
End If
End With
End Sub
Private Sub makeHTML_Click()
Dim DestFile As String
Dim htmlOut As String
Dim FileNum As Integer
Dim ColumnCount As Integer
Dim RowCount As Integer
Dim vbTableWith As String
Dim vbTableFStyle As String
Dim vbCellWith As String
Dim vbCellBGColor As String
Dim vbCellFStyle As String
Dim vbFontColor As String
Dim vbBold As String
Dim vbItalic As String
Dim outputObj As New DataObject
'if style or class information is used write
'it to the sorresponding string variable
If Trim(tableStyle.Text) <> "" Then
vbTableStyle = " style='" & tableStyle.Text & "' "
Else
vbTableStyle = ""
If Trim(tableClass.Text) <> "" Then
vbTableClass = " class='" & tableClass.Text & "' "
Else
vbTableClass = ""
If Trim(tableId.Text) <> "" Then
vbTableId = " id='" & tableId.Text & "' "
Else
vbTableId = ""
If Trim(rowStyle.Text) <> "" Then
vbRowStyle = " style='" & rowStyle.Text & "' "
Else
vbRowStyle = ""
If Trim(rowClass.Text) <> "" Then
vbRowClass = " class='" & rowClass.Text & "' "
Else
vbRowClass = ""
If Trim(cellStyle.Text) <> "" Then
vbCellStyle = " style='" & cellStyle.Text & "' "
Else
vbCellStyle = ""
If Trim(cellClass.Text) <> "" Then
vbCellClass = " class='" & cellClass.Text & "' "
Else
vbCellClass = ""
'used for specific width
If cellWidth = True Then
vbTableWidth = " width:" & Selection.Columns.Width & "; "
End If
'stretch table to 100%
If table100pct = True Then
vbTableWidth = " width:100%; "
End If
vbTableFStyle = " style='" & vbTableWidth & "' "
'Write the table
htmlOut = "<table cellpadding=0 cellspacing=0 border=0 " & _
vbTableId & vbTableStyle & vbTableClass & _
vbTableFStyle & ">" & vbCrLf
' Loop for each row in selection.
For RowCount = 1 To Selection.Rows.Count
' Loop for each column in selection.
htmlOut = htmlOut & "<tr" & vbRowClass & vbRowStyle & ">" & vbCrLf
For ColumnCount = 1 To Selection.Columns.Count
'if the width is fixed then preserve width of each cell
If cellWidth = True Then
vbCellWidth = " width:" & _
Selection.Cells(RowCount, ColumnCount).Width & "; "
Else
vbCellWith = ""
End If
'if checked use font color
If useFontColor = True Then
vbFontColor = " color: " & _
index2Hex(Selection.Cells(RowCount, _
ColumnCount).Font.colorIndex) & "; "
Else
vbFontColor = ""
End If
'if checked use background color
If useBGColor = True Then
vbCellBGColor = " background: " & _
index2Hex(Selection.Cells(RowCount, _
ColumnCount).Interior.colorIndex) & "; "
Else
vbCellBGColor = ""
End If
'if checked use Bold
If useBold = True Then
If Selection.Cells(RowCount, _
ColumnCount).Font.Bold = True Then
vbBold = " font-weight: bold; "
End If
Else
vbBold = ""
End If
'if checked use italic
If useItalic = True Then
If Selection.Cells(RowCount, _
ColumnCount).Font.Italic = True Then
vbItalic = " font-style: italic; "
End If
Else
vbItalic = ""
End If
vbCellFStyle = " style='" & vbFontColor & vbCellWidth _
& vbCellBGColor & vbBold & vbItalic & "' "
' Write current cell's text
htmlOut = htmlOut & "<td" & vbCellClass & vbCellStyle _
& vbCellFStyle & ">" & Selection.Cells(RowCount, _
ColumnCount).Text & "</td>"
' Check if cell is in last column.
If ColumnCount = Selection.Columns.Count Then
' If so, then write a blank line.
htmlOut = htmlOut & vbCrLf
End If
' Start next iteration of ColumnCount loop.
Next ColumnCount
' Start next iteration of RowCount loop.
htmlOut = htmlOut & "</tr>" & vbCrLf
Next RowCount
htmlOut = htmlOut & "</table>" & vbCrLf
'force rendering of empty cells
If emptyCell = True Then htmlOut = Replace(htmlOut, "></td>", "> </td>")
'Writing HTML to file if checked
If Trim(filePath.Text) <> "" Then
DestFile = filePath.Text
' Obtain next free file handle number.
FileNum = FreeFile()
' Turn error checking off.
On Error Resume Next
' Attempt to open destination file for output.
Open DestFile For Output As #FileNum
' If an error occurs report it and end.
If Err <> 0 Then
MsgBox Err.Description
MsgBox "Cannot open filename " & DestFile
End
Else
Print #FileNum, htmlOut;
' Close destination file.
Close #FileNum
End If
End If
' Turn error checking on.
On Error GoTo 0
'if checked copy HTML to clipboard
If copyClipboard.Value = True Then
outputObj.SetText (htmlOut)
outputObj.PutInClipboard
End If
End
End Sub
Private Sub table100pct_Change()
If table100pct.Value = True Then cellWidth.Value = False
End Sub
'a lookup table to convert a ColorIndex value
'to its Hex equivilant
Private Function index2Hex(index)
Dim hexColor As String
Dim colorTable(56) As String
colorTable(1) = "#000000"
colorTable(2) = "#FFFFFF"
colorTable(3) = "#FF0000"
colorTable(4) = "#00FF00"
colorTable(5) = "#0000FF"
colorTable(6) = "#FFFF00"
colorTable(7) = "#FF00FF"
colorTable(8) = "#00FFFF"
colorTable(9) = "#800000"
colorTable(10) = "#008000"
colorTable(11) = "#000080"
colorTable(12) = "#808000"
colorTable(13) = "#800080"
colorTable(14) = "#008080"
colorTable(15) = "#C0C0C0"
colorTable(16) = "#808080"
colorTable(17) = "#9999FF"
colorTable(18) = "#993366"
colorTable(19) = "#FFFFCC"
colorTable(20) = "#CCFFFF"
colorTable(21) = "#660066"
colorTable(22) = "#FF8080"
colorTable(23) = "#0066CC"
colorTable(24) = "#CCCCFF"
colorTable(25) = "#000080"
colorTable(26) = "#FF00FF"
colorTable(27) = "#FFFF00"
colorTable(28) = "#00FFFF"
colorTable(29) = "#800080"
colorTable(30) = "#800000"
colorTable(31) = "#008080"
colorTable(32) = "#0000FF"
colorTable(33) = "#00CCFF"
colorTable(34) = "#CCFFFF"
colorTable(35) = "#CCFFCC"
colorTable(36) = "#FFFF99"
colorTable(37) = "#99CCFF"
colorTable(38) = "#FF99CC"
colorTable(39) = "#CC99FF"
colorTable(40) = "#FFCC99"
colorTable(41) = "#3366FF"
colorTable(42) = "#33CCCC"
colorTable(43) = "#99CC00"
colorTable(44) = "#FFCC00"
colorTable(45) = "#FF9900"
colorTable(46) = "#FF6600"
colorTable(47) = "#666699"
colorTable(48) = "#969696"
colorTable(49) = "#003366"
colorTable(50) = "#339966"
colorTable(51) = "#003300"
colorTable(52) = "#333300"
colorTable(53) = "#993300"
colorTable(54) = "#993366"
colorTable(55) = "#333399"
colorTable(56) = "#333333"
If index = xlColorIndexNone Then index = 2
If index = xlColorIndexAutomatic Then index = 1
hexColor = colorTable(index)
index2Hex = hexColor
End Function
关注点
这段代码非常简单，我制作起来很有趣。作为一名Web开发人员，它对我来说非常有价值。我没有在较旧的Office版本上进行测试，但我认为任何更改都将很容易实现。我希望有时间回来改进代码，但如果您先于我，请给我发消息，让我看看您对它做了什么。一些建议是：
- 自动化脚本，以在文件夹中的所有Excel文件或文件中的所有工作表中运行。
- 能够在写入最终HTML之前预览和更改单个单元格或行的样式信息。
- 列跨度和行跨度。
- 您能想到的任何DHTML行为。
- 一个简单的更改是可选地交替表格行的背景颜色。