如何使用Excel/VBA将多个不连续区域导出到单个HTML文件

报错原因 #

运行时错误 '1004': This action won't work on multiple selections

Excel原生不支持对Union生成的多区域（Range.Areas.Count > 1）直接执行复制操作，原代码没有处理多区域遍历逻辑，仅支持单个区域入参。

兼容多区域的导出函数 #

修改逻辑为遍历传入区域的所有子区域，按顺序逐个粘贴到临时工作表，自动计算每次粘贴的起始行，实现多区域上下拼接，完全兼容单个区域使用场景。

Public Function PublishPlan(rngToPublish As Range, location As String) As String
    Dim fso As Object
    Dim ts As Object
    Dim TempWB As Workbook
    Dim area As Range
    Dim nextRow As Long
    
    ' 初始化临时工作簿
    Set TempWB = Workbooks.Add(1)
    nextRow = 1 ' 第一个区域的粘贴起始行
    
    ' 遍历所有子区域，按顺序上下拼接
    With TempWB.Sheets(1)
        For Each area In rngToPublish.Areas
            area.Copy
            ' 粘贴列宽、值、格式
            .Cells(nextRow, 1).PasteSpecial Paste:=8 ' 列宽
            .Cells(nextRow, 1).PasteSpecial xlPasteValues, , False, False
            .Cells(nextRow, 1).PasteSpecial xlPasteFormats, , False, False
            ' 计算下一个区域的起始行
            nextRow = nextRow + area.Rows.Count
            Application.CutCopyMode = False
        Next area
        
        ' 清理临时表的绘图对象
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    ' 导出为HTML
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=location, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    ' 读取HTML内容并修改对齐方式
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(location).OpenAsTextStream(1, -2)
    PublishPlan = ts.ReadAll
    ts.Close
    PublishPlan = Replace(PublishPlan, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    TempWB.Close savechanges:=False
    
    ' 释放对象
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
    Set area = Nothing
End Function

调用示例 #

Sub TestMultiAreaPublish()
    Dim rng1 As Range, rng2 As Range, combineRng As Range
    ' 定义需要拼接的多个区域
    Set rng1 = Sheet1.Range("A1:D4")
    Set rng2 = Sheet1.Range("F1:H6")
    Set combineRng = Union(rng1, rng2)
    ' 导出到指定路径
    Call PublishPlan(combineRng, "C:\Users\xxx\Desktop\导出结果.html")
End Sub

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