ExcelTip.Net留存知识帖 ---【注:附件之前被网盘供应商清空后,现已修复-现已修复-现已修复为本地下载!】
现在位置:首页 > E问E答 > Excel VBA > 如何控制插入图片的面积大小一致?

如何控制插入图片的面积大小一致?

作者:绿色风 分类: 时间:2022-08-17 浏览:197
楼主
kevinchengcw
Q: 要插入文档的图片有大有小,有横在竖,如何控制插入图片的大小基本一致?
A: 我们可以通过控制插入图片的面积大小来使图片的视觉尺寸基本一致,示例代码如下:
  1. Sub test()
  2. Dim Fn As String
  3. Dim M, I, W, H As Double
  4. I = 40000  '设定图像的面积大小(长*宽)
  5. Fn = Dir(ThisWorkbook.Path & "\*.jpg")  '列举当前工作簿目录下的jpg图片
  6. If Fn = "" Then MsgBox "请在当前工作簿文件夹中放入几个图片进行测试", vbOKOnly, "": Exit Sub  '如果当前工作簿所在文件夹没有图片则提示后退出
  7. M = 1  '设定单元格坐标起始量
  8. Do While Fn <> ""  '循环插入当前工作簿路径下的jpg图片
  9.     ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Fn).Select  '向活动工作表中插入图片并选中
  10.     With Selection
  11.         W = .Width  '记录下图片的原始宽度
  12.         H = .Height  '记录下图片的原始高度
  13.         .Top = Cells(M, M).Top  '设定图片的新位置
  14.         .Left = Cells(M, M).Left
  15.         .Width = Sqr(I * W / H) '根据原始宽高比设置新的尺寸
  16.         .Height = Sqr(I * H / W)
  17.     End With
  18.     M = M + 2  '图片位置单元格移动
  19.     If M > 12 Then Exit Do  '本示范为避免插入太多图片,当插入五个后退出循环
  20.     Fn = Dir  '下一个图片
  21. Loop
  22. MsgBox "插入完成", vbOKOnly, ""
  23. End Sub

本示例将当前工作簿下的图片的前六个插入到活动工作表中,不论图片长宽比如何其插入后的面积都基本一致。
附示例文件。
控制插入的图片的面积大小基本一致.rar
2楼
hanter007
留个记号,说不定会用到.谢谢
3楼
wnianzhong
收藏一下,谢谢!
4楼
289063492
附件怎么用不了呢?
5楼
ljx63426
收藏一下,谢谢!

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素, 经与ExcelTip.Net站长Apolloh商议并征得其同意, 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示, 供有需要的人士查询使用,也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议, 可与本人沟通提出,或于本站点留言,我们会尽快处理。 在此,感谢ExcelTip.Net站长Apolloh的支持,感谢本站点所有人**绿色风(QQ:79664738)**的支持与奉献,特此鸣谢!
------本人网名**KevinChengCW(QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表
sitemap