excel 表格批量隔行插入图片

Charles_Song · 发表于 2021-10-6 12:43

各位老师好！
本人想在文件“表格1”点击“图片插入”按钮，要求“图片文件夹”中的所有图片自动全部导入到A2,B2,C2,D2,A4,B4,....., （隔行插入）所导入的图片尺寸大小、对中应和这些单元格大小匹配
谢谢老师！

梦幻的流星 · 发表于 2021-10-6 14:54

图片导入.zip (95.13 KB, 下载次数: 14)

3190496160 · 发表于 2021-10-6 14:55

Sub 插入图片()
Dim oWb As Object
Dim intFilesCount As Integer
Dim strFilePath As String
Application.ScreenUpdating = False '屏幕闪烁关闭
Dim oFd As Object
Dim rng As Range
Dim shp
For Each shp In ActiveSheet.Pictures
shp.Delete
Next shp
f = Dir(ThisWorkbook.Path & "\图片文件夹\*.gif")
hh = 2
lh = 1
Do While f <> ""
Cells(hh, lh).Select
Set rng = ActiveCell
cellL = ActiveCell.Left + 3
cellT = ActiveCell.Top
strFilePath = ThisWorkbook.Path & "\图片文件夹\" & f
Set shpPic = ActiveSheet.Shapes.AddPicture(strFilePath, msoFalse, msoTrue, cellL, cellT, 1, 1)
shpPic.Top = rng.Offset(m).Top + 1
shpPic.Left = rng.Offset(m).Left + 1
shpPic.Width = rng.Offset(m).Width - 1
shpPic.Height = rng.Offset(m).Height - 1
Set shpPic = Nothing
'hh = hh + 2
lh = lh + 1
If lh > 4 Then
      lh = 1
      hh = hh + 2
Else
      lh = lh
      hh = hh
End If
f = Dir
Loop
Application.ScreenUpdating = True '屏幕闪烁打开
MsgBox "ok"
End Sub

3190496160 · 发表于 2021-10-6 14:56

图片导入.rar (164.84 KB, 下载次数: 25)

Charles_Song · 发表于 2021-10-7 00:20

梦幻的流星发表于 2021-10-6 14:54

受教了，非常感谢！老师您辛苦了！

Charles_Song · 发表于 2021-10-7 00:21

3190496160 发表于 2021-10-6 14:56

受教了，非常感谢！老师您辛苦了！

Charles_Song · 发表于 2021-10-7 00:23

请问如何赠送鲜花？

Charles_Song · 发表于 2021-10-7 00:26

非常感谢两位老师！非常好用非常方便！

ExcelAPInet · 发表于 2021-10-9 12:11

如果图片名称有规律的话，可以使用AddPicture(image_path)公式批量添加图片

Charles_Song · 发表于 2022-1-15 22:25

谢谢老师！这个方法更简单！

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

[求助] excel 表格批量隔行插入图片