Excel单元格中自适应填充多图
实例需求:在Excel插入图片时,由于图片尺寸各不相同,如果希望多个图片填充指定单元格,依靠用户手工调整,不仅费时费力,而且很难实现完全填充。如下图中的产品图册,有三个图片,如下图所示。
在不改变C列宽度的情况下,需要将三个图片调整为相同高度,并且填满单元格(可以修改行高)。
Sub Demo()
Dim rngCell As Range, oShp As Shape
Dim wAll As Double, r As Double, iLeft As Double
Set rngCell = Range("C2")
For Each oShp In Sheet1.Shapes
oShp.LockAspectRatio = msoCTrue
oShp.Height = 100
wAll = wAll + oShp.Width + 1
Next
r = rngCell.Width / (wAll + 1)
iLeft = rngCell.Left + 1
For Each oShp In Sheet1.Shapes
oShp.Height = 100 * r
oShp.Top = rngCell.Top + 1
oShp.Left = iLeft
iLeft = iLeft + oShp.Width + 1
Next
rngCell.RowHeight = Sheet1.Shapes(1).Height + 2
End Sub
【代码解析】
第5行代码指定图片填充单元格。
第6~10行代码循环遍历工作表Sheet1中的图片。
第7行代码锁定图片的纵横比,避免调整图片尺寸导致图片变形。
第8行代码统一图片高度。
第9行代码统计图片的累计宽度,此处加一作为相邻图片之间的间隔。
第11行代码计算缩放比例。
第12行代码计算图片的水平偏移位置,第一图片的偏移量于单元格的Left属性相同,即对齐被填充单元格的左侧。此处增加偏移量为1,是为了避免图片覆盖单元格边框线。
第13~18行代码循环遍历工作表Sheet1中的图片,设置图片位置和尺寸。
第14行代码修改图片高度,由于锁定了纵横比,因此图片的宽度也会按同比例变化。
第15行代码设置图片Top属性于被填充单元格相同,即对齐被填充单元格顶部。
第16行代码调整图表位置。
第17行代码累加当前图片宽度,计算下一个图片位置。
第19行代码修改被填充单元格的高度,以适配图片高度。