引
近期需在Excel中插入相关图片,因图片数量比较多,想着是否能够用VBA来解决,一劳永逸。[1]
第一步 实现在Excel中实现插入图片功能。
新建文件夹,Excel文件放入;再新建“照片”文件夹。框架及代码如下:
![b3c34b40cec359dce839eafe74ef744f.png](https://i-blog.csdnimg.cn/blog_migrate/ac39c213cab2ac72a37a73073c660587.png)
Sub 插入照片()
Dim Path As String '图片文件夹路径
Dim PicturePath As String '图片路径
Path = ThisWorkbook.Path & "照片"
PicturePath = Path & "01.jpg"
Debug.Print PicturePath '用来测试输出的图片路径是否正确,在立即窗口显示;Ctrl+G打开
'以下 With……End With 部分为核心代码层
With Cells(3, "C")
ActiveSheet.Shapes.AddPicture PicturePath, _
linktofile:=True, savewithdocument:=True, _
Left:=.Left + 2, Top:=.Top + 2, _
Width:=.Width - 4, Height:=.Height - 4
End With
End Sub
以上代码只能实现单个图片的插入。第二步就要实现批量插入文件夹中的图片啦。
第二步 实现批量插入图片功能
到批量插入中间过程
Sub 插入照片()
Dim Path As String '图片文件夹路径
Dim PicturePath As String '图片路径
Dim PictureName As String '图片名称
Dim cell As Range '作为插入图片的单元格使用
Path = ThisWorkbook.Path & "照片"
PictureName = Dir(Path & "*.jpg") '自动查询Path路径下所有图片名称
'简单设置单元格宽度与高度,后期会设置为自动设置
Cells(3, "C").ColumnWidth = 20
Cells(3, "C").RowHeight = 150
Cells(4, "C").RowHeight = 150
Range("C3:C4").Select '测试代码,故只选了两个单元格
For Each cell In Selection
With cell
PicturePath = Path & PictureName
ActiveSheet.Shapes.AddPicture PicturePath, _
linktofile:=True, savewithdocument:=True, _
Left:=.Left + 2, Top:=.Top + 2, _
Width:=.Width - 4, Height:=.Height - 4
End With
PictureName = Dir '继续查找下一个图片名称
Next
End Sub
看了下时间,已经写了两个小时了。非专业人员,也是第一次写东西,措辞方面改了好多遍,哈哈。不过感觉更有框架感了。已经晚上八点半了,江南的冬天比较冷,先写到这吧,空了再继续(也许明天就有可空)——写于2020年12月1日,冬,江苏常州
参考
- ^哈哈,主要还是为了能够偷懒