作者：绿色风
分类：
时间：2022-08-17
浏览：182
楼主
amulee |
Q：如何用VBA批量插入图片并按单元格大小自动等比例缩放？
A：如下例，在工作簿文件夹下的PIC文件夹内有按照A列数据命名的图片。如何批量插入这些图片到D列，并按照D列的单元格大小自动按原始比例调整图片大小，实现如下效果？
参考以下代码：
- Sub 图片导入()
- '将图片导入。
- '每行行高设定为50，列宽不变。
- '图片按照原比例存储，按照原比例存储
- On Error Resume Next
- Dim R&
- Dim Pic As Object
- '先删除所有的图片
- For Each Pic In Sheet1.Shapes
- If Pic.Name <> Sheet1.Shapes("按钮 97").Name Then
- Pic.Delete
- End If
- Next
- For R = 2 To Range("A65536").End(xlUp).Row
- Set Pic = Sheet1.Pictures.Insert(ThisWorkbook.Path & "\pic\" & Cells(R, 1) & ".jpg")
- '锁定高宽比
- Pic.ShapeRange.LockAspectRatio = True
- '看高宽比。如果图片高宽比高，那么调整到单元格高度，否则调整到单元格宽度
- '我们看到的右键格式菜单里的东西都是针对ShapeRange而言的，所以要用ShapeRange来设定
- With Pic.ShapeRange
- If .Height / .Width > Cells(R, 4).Height / Cells(R, 4).Width Then
- .Height = Cells(R, 4).Height
- .Top = Cells(R, 4).Top
- .Left = Cells(R, 4).Left + (Cells(R, 4).Width - .Width) / 2
- Else
- .Width = Cells(R, 4).Width
- .Left = Cells(R, 4).Left
- .Top = Cells(R, 4).Top + (Cells(R, 4).Height - .Height) / 2
- End If
- End With
- Next R
- End Sub
 批量导入图片.rar
|
2楼
zchsoft |
做记号，高高 |
3楼
qdym |
新人进来学习，谢谢！ |
4楼
yangkd2011 |
谢谢分享，如果我要把图片在B列显示怎么改？
还有我要是修改只要一个姓名，图片在制定的
位置显示又怎么改？不懂VBA啊。谢谢** |
5楼
0Mouse |
“我们看到的右键格式菜单里的东西都是针对ShapeRange而言的，所以要用ShapeRange来设定。”
.Top、.Left、.Height、.Width这四个属性直接对Pic进行设置应该也可以，下帖为证。
如何在指定的单元格位置插入图片？
http://www.exceltip.net/thread-9623-1-1.html
|
6楼
add58 |
新人进来学习，谢谢！ |
7楼
lrlxxqxa |
学习 |
8楼
hustclm |
学习了，感谢阿木分享
 |
9楼
563594008 |
好东西啊，新人进来学习 |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一