如何修改Ron de Bruin Outlook邮件代码中HTML表格指定列宽？

针对你使用Ron de Bruin的rangetoHTML函数无法精确设置列宽的问题，提供两种可行方案：

方案1：调整临时工作表列宽后再发布 #

Excel的ColumnWidth（字符单位）和HTML宽度并非直接映射，但可先在临时工作表中精确设置列宽，再发布为HTML。修改代码中临时工作表的处理部分即可：

Function rangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2013
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook

TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
    .Cells(1).Select
    .Cells(1).PasteSpecial Paste:=8 ' 粘贴原区域列宽
    .Cells(1).PasteSpecial xlPasteValues, , False, False
    .Cells(1).PasteSpecial xlPasteFormats, , False, False
    
    ' ========== 新增：精确设置指定列宽 ==========
    ' 方法A：用Excel列宽单位（字符数）设置
    .Columns(1).ColumnWidth = 15 ' 设置第1列为15
    .Columns(3).ColumnWidth = 15 ' 设置第3列为15
    ' 方法B：用像素设置更精准（对应约15列宽的像素值可手动测试获取）
    '.Columns(1).Width = 110
    '.Columns(3).Width = 110
    ' ==========================================
    
    Application.CutCopyMode = False
    On Error Resume Next
    .DrawingObjects.Visible = True
    .DrawingObjects.Delete
    On Error GoTo 0
End With

'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
     SourceType:=xlSourceRange, _
     Filename:=TempFile, _
     Sheet:=TempWB.Sheets(1).Name, _
     Source:=TempWB.Sheets(1).UsedRange.Address, _
     HtmlType:=xlHtmlStatic)
    .Publish (True)
End With

'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
rangetoHTML = ts.readall
ts.Close
rangetoHTML = Replace(rangetoHTML, "align=center x:publishsource=", _
                      "align=left x:publishsource=")

'Close TempWB
TempWB.Close savechanges:=False

'Delete the htm file we used in this function
Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing

End Function

方案2：直接修改生成的HTML代码 #

如果方案1不生效，可在生成HTML后，通过替换标签属性强制设置列宽。比如给表头<th>和单元格<td>添加宽度样式：

在rangetoHTML = Replace(rangetoHTML, "align=center x:publishsource=", ...)之后，新增以下代码：

' ========== 新增：修改HTML中的列宽 ==========
' 示例：设置第1列宽度为110px，第2列为80px
' 先替换表头<th>的宽度
rangetoHTML = Replace(rangetoHTML, "<th ", "<th style=""width:110px;"" ", Count:=1) ' 第1列表头
rangetoHTML = Replace(rangetoHTML, "<th ", "<th style=""width:80px;"" ", Count:=1) ' 第2列表头

' 批量替换所有行的第1列<td>宽度
Dim regex As Object
Set regex = CreateObject("VBScript.RegExp")
regex.Global = True
regex.Pattern = "(<td[^>]*>)"
Dim matches As Object
Set matches = regex.Execute(rangetoHTML)
Dim i As Integer
For i = 0 To matches.Count - 1
    If (i Mod rng.Columns.Count) = 0 Then ' 匹配第1列（索引从0开始）
        rangetoHTML = Replace(rangetoHTML, matches(i).Value, "<td style=""width:110px;"">", Count:=1)
    End If
Next i
Set regex = Nothing
' ==========================================

注意：第二种方法需要根据你的列数调整逻辑，确保对应列被正确替换。

内容的提问来源于stack exchange，提问作者HugoLny