如何将批量将图片插入EXCEL表中

韬韬他妈

批量插入图片附件.rar (214.63 KB, 下载次数: 139)

2015-7-24 13:48 上传

点击文件名下载附件

我目前在做固定资产卡片，要将每个固定资产二维码的图片插入到EXCEL中，工作实在太繁重，
在网上查找了方法，都不实用，因为我的表格很多都是合并单元格

D7要插入以D5的内容命名的图片
N7要插入以N5的内容命名的图片
X7要插入以X5的内容命名的图片
D18要插入以D16的内容命名的图片
N18要插入以N16的内容命名的图片
X18要插入以X16的内容命名的图片
D29要插入以D27的内容命名的图片
N29要插入以N27的内容命名的图片
X29要插入以X27的内容命名的图片
D40要插入以D38的内容命名的图片
N40要插入以N38的内容命名的图片
X40要插入以X38的内容命名的图片
D51要插入以D49的内容命名的图片
N51要插入以N49的内容命名的图片
X51要插入以X49的内容命名的图片
D62要插入以D60的内容命名的图片
N62要插入以N60的内容命名的图片
X62要插入以X60的内容命名的图片
D73要插入以D71的内容命名的图片
N73要插入以N71的内容命名的图片

刀羊

貌似插入多个图片对象是按图片名称排序的，如果这个顺序在Excel是不是标准的，可以做个自定义排序。

wdx223

1. Sub InsertPic()
   
2. Dim rng As Range, rw As Range, picpath As String
   
3. 
   
4. Set rng = [D1:AD80]
   
5. ActiveSheet.DrawingObjects.Delete
   
6. For Each rw In rng
   
7.     If rw.MergeArea.Rows.Count = 7 And rw.MergeArea.Columns.Count = 7 And rw.Column = rw.MergeArea.Column And rw.Row = rw.MergeArea.Row Then
   
8.         picpath = ThisWorkbook.Path & "\图片附件" & rw.Offset(-2, 0) & rw.Offset(0, -2) & "15" & Mid(rw.Offset(-4, -2), 5, Len(rw.Offset(-4, -2)) - 6) & ".jpg"
   
9.         If Dir(picpath) <> "" Then
   
10.             With ActiveSheet.Pictures.Insert(picpath)
    
11.                 .Top = rw.Top + (rw.MergeArea.Height - 62.25) / 2
    
12.                 .Left = rw.Left + (rw.MergeArea.Width - 62.25) / 2
    
13.                 .Height = 62.25
    
14.             End With
    
15.         End If
    
16.     End If
    
17. Next rw
    
18.    
    
19. End Sub
    

复制代码

韬韬他妈

wdx223 发表于 2015-7-24 14:55

谢谢，非常感谢，要好好学习，也象您一样帮助更多的人

chenzhuoshijin

好资料，学习了

snwhsy

wdx223 发表于 2015-7-24 14:55

上传的材料，已经引入了数据，实现了批量打印，请大神帮助解决按物品名称导入图片！不用邮件合并，也不用数据源给出图片地址，直接按物品名称导入图片，先谢了！！！！

snwhsy

snwhsy 发表于 2022-1-3 16:37
上传的材料，已经引入了数据，实现了批量打印，请大神帮助解决按物品名称导入图片！不用邮件合并，也不用 ...

问题已解决，用的是最笨的方法，现分享，也希望大神优化。