Excel批量插入图片并排列图片

shangqijiang · 发表于 2022-4-11 17:19

各位大神:
小弟想烦请大神指教一下,具体要求如下:
1.前提是Excel单元格的列宽度不能变.
2.VBA批量插入图片的方式,插入图片张数为1张~5张不等.
3.插入图片后,需要用VBA代码按照"序号5"下方的排列方式和间距进行
排列,需要肉眼看起来差不多水平及间距相等就行.
4.批量插入的图片尺寸大小是一样的.

shangqijiang · 发表于 2022-4-11 21:14

这是没有大神帮忙吗?

aman1516 · 发表于 2022-4-11 23:32

shangqijiang 发表于 2022-4-11 21:14
这是没有大神帮忙吗?

"插入图片张数为1张~5张不等"——但插入图片的条件却没说，如何确定”序号5"即23行插入哪几张呢？，序号6，在哪里，又插入几张？........
难怪十几人下载了都没法回复，
插入条件明确了，那就简单了，还是先全部先按条件插入A列对应单元格（全部重叠一堆都无所谓），再循环一下按行辅开图片就好了，无非就是设定 pic.Top 和 pic.Left 罢了

3190496160 · 发表于 2022-4-12 07:32

求助务必把需求描述清楚，才可能得到别人的帮助，插入图片的问题，我的主题里有分享的帖子，可以去看看，也许对你有帮助，

aman1516 · 发表于 2022-4-12 14:06

插入文件夹内图片并5个为一排

Option Compare Text
Sub StoPic()
Dim Fso, ff, f, prr(), r, c, i, j, k, p, q
Dim Pl, Pt, Pw, Ph, Img 'As ImageFile
Set Img = CreateObject("WIA.ImageFile")
On Error Resume Next
Set Fso = CreateObject("scripting.filesystemobject")
Set ff = Fso.Getfolder(ThisWorkbook.Path & "\案例")
ReDim prr(1 To ff.Files.Count)
p = 0
For Each f In ff.Files
If InStr(f, ".JPG") Then
p = p + 1
prr(p) = f
End If
Next
i = 0
With Sheet1
Call delshp
For q = 1 To p
Img.LoadFile prr(q)
Pw = Img.Width / 2
Ph = Img.Height / 2
c = q Mod 5
If c = 1 Then
i = i + 1
r = 2 + (i - 1) * 21
Else
If c = 0 Then c = 5
End If
Pl = (c - 1) * (Pw + 10)
Pt = .Range("A" & r).Top
.Shapes.AddPicture prr(q), True, True, Pl, Pt, Pw, Ph
Next
End With
MsgBox "ok!"
End Sub
Sub delshp()
Dim shp As Shape
For Each shp In Sheet1.Shapes
If shp.Type <> 8 And shp.Type <> 12 Then
shp.Delete
End If
Next
End Sub

复制代码

楼主附件似乎有病毒，请自行测试

鑫尼达 · 发表于 2022-4-12 17:20

aman1516 发表于 2022-4-12 14:06
插入文件夹内图片并5个为一排

楼主附件似乎有病毒，请自行测试

有没有找到是什么代码病毒,下载下来第一次打开好像会自动运行什么,后面看不到了,也没见有代码

shangqijiang · 发表于 2022-4-12 21:08

鑫尼达发表于 2022-4-12 17:20
有没有找到是什么代码病毒,下载下来第一次打开好像会自动运行什么,后面看不到了,也没见有代码

我没有写代码,只是一个纯案例而已.我确认过了,压缩档里面是没有病毒的.请再确认一下,谢谢!

shangqijiang · 发表于 2022-4-12 21:36

本帖最后由 shangqijiang 于 2022-4-12 22:37 编辑

aman1516 发表于 2022-4-12 14:06
插入文件夹内图片并5个为一排

楼主附件似乎有病毒，请自行测试

大神，您好，
首先特别感谢您无私的帮助，这个的确就是我所需要的功能,
我写错了两点，可否再帮忙优化以下两点：
1.插入的图片格式限制为(.jpg，.bmp，.gif，.png)等格式。
2.图片插入至Excel后，将图片大小尺寸统一等比缩放为：高度(6.77厘米)、宽度(9.03厘米)。

shangqijiang · 发表于 2022-4-13 13:09

aman1516 发表于 2022-4-12 14:06
插入文件夹内图片并5个为一排

楼主附件似乎有病毒，请自行测试

还请您再操刀修改一下,麻烦了,谢谢

aman1516 · 发表于 2022-4-13 16:14

shangqijiang 发表于 2022-4-13 13:09
还请您再操刀修改一下,麻烦了,谢谢

1）将 If InStr(f, ".JPG") Then  改为下面代码（自己选择哪些图片类别）
      If InStr(f, "bmp") Or InStr(f, "png") Or InStr(f, "jpg") Or InStr(f, "jpeg") Or InStr(f, "gif") Or InStr(f, "tif") Or InStr(f, "wmf") Or InStr(f, "ico") Or InStr(f, "cur") Then          ' 不支持"png"格式图片
2）将  Pw = Img.Width / 2
      Ph = Img.Height / 2  这两句改为指定值即可
如： Pw = 345
      Ph = 260  即可

		自动登录	找回密码
密码			免费注册