使用VBA快速生成Excel工作表非连续列图片快照

Excel中示例数据如下图所示。

现在需要拷贝A2:A15,D2:D15,J2:J15,L2:L15,R2:R15为图片，然后粘贴到A18单元格，如下图所示。

大家都知道VBA中Range对象有CopyPicture方法可以拷贝为图片，但是如果Range对象为非连续区域，那么将产生1004错误，例如：Range("A2:A15,D2:D15").CopyPicture

示例代码如下。

vb 复制代码

Sub CopyMultiAreasRange()
    Dim sRng As Range, firstC As Range, lastC As Range
    With ThisWorkbook.Sheets(2)
        Set sRng = .Range("A2:A15,D2:D15,J2:J15,L2:L15,R2:R15")
        Set firstC = sRng.Areas(1).Cells(1)
        With sRng.Areas(sRng.Areas.Count)
            Set lastC = .Cells(.Cells.Count)
        End With
        For i = firstC.Column To lastC.Column
            If Intersect(sRng, .Columns(i)) Is Nothing Then
                .Columns(i).Hidden = True
            End If
        Next
        Range(firstC, lastC).CopyPicture xlPrinter, xlPicture
        .Range("A18").Select
        .Paste
        .Columns.Hidden = False
    End With
End Sub

【代码解析】

第4行代码获取指定单元格范围（一些简称为源数据）。

第5行代码获取源数据的第一个单元格。

第6~8行代码获取源数据的最后一个单元格。

第9~13行代码循环遍历列。

第10行代码判断该列是否与源数据有交叉，如果不存在交叉，那么第11行代码隐藏列。

第14行代码拷贝源数据区域为图片，Range(firstC, lastC)为扩展的连续单元格区域。

第15行代码选中目标单元格。

第16行代码粘贴图片。

第17行代码取消隐藏列。

注意：本示例代码仅适用于多个单列非连续区域，并且每个单元格子区域起始行和结束行都相同的场景，如果非连续区域是其他形式的，大家可以修改代码使用类似的思路实现。