之前在小桥流水看到有人问怎样在Excel批量导入图片,随手写了个宏,没想到今天又有人问我,中午把VBA小改一下
图片用1.jpg 2.jpg 3.jpg … 10.jpg 12.jpg依次命名
图片间隔是2张相邻图片左上角的间隔,例如图片尺寸100像素,间隔写100就刚好紧挨着
默认开始位置是以选择框所在位置,例如下图,选择框在B2,图片就从B2开始排列了
演示下载,解压到D盘就可以直接执行了,如果打开弹出提示窗口,是因为你Excel安全性设置高,没事,一样可以执行
VBA代码如下1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30Sub Macro1()
' 宏由 CAT 录制,时间: 2007-2-7
' 批量导入图片
Dim picPath, picWidth, picHeight, fileExt
picPath = "D:\" '图片存放路径
picN = 4 '图片数量
fileExt = ".jpg" '图片后缀名
picScale = 30 '图片缩放百分比,不带 %
perPic = 2 '每行图片数量
xWidth = 202 '图片水平间隔,即水平相邻的图片左上角间隔
xHeight = 152 '图片垂直间隔
Dim x, y
x = 0
y = 0
For i = 1 To picN
ActiveSheet.Pictures.Insert(picPath & i & fileExt).Select
Selection.ShapeRange.ScaleWidth picScale / 100, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight picScale / 100, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.IncrementLeft xWidth * x
Selection.ShapeRange.IncrementTop xHeight * y
If i Mod perPic = 0 Then
x = 0
y = y + 1
Else
x = x + 1
End If
Next
End Sub