Excel中示例数据如下图所示。
现在需要拷贝A2:A15,D2:D15,J2:J15,L2:L15,R2:R15
为图片,然后粘贴到A18单元格,如下图所示。
大家都知道VBA中Range对象有CopyPicture
方法可以拷贝为图片,但是如果Range对象为非连续区域,那么将产生1004错误,例如:Range("A2:A15,D2:D15").CopyPicture
示例代码如下。
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行代码取消隐藏列。
注意:本示例代码仅适用于多个单列非连续区域,并且每个单元格子区域起始行和结束行都相同的场景,如果非连续区域是其他形式的,大家可以修改代码使用类似的思路实现。