【Excel VBA】2018-09-30 指定单元格位置批量插入图片

案例

案例来源：Excel和Access （微信公众号）点击 - 查看原文

案例图一

在指定单元格位置，批量插入多张图片。

附件：点击查看-百度云
提取密码：i4n0

一、数据源代码

复制代码到Excel 表里，可以直接生案例数据。

Sub 数据源代码()
    '录入数据
    Cells(1, 1) = "代号"
    Cells(1, 2) = "姓名"
    Cells(1, 3) = "部门"
    Cells(1, 4) = "照片"
    Cells(2, 1) = "A12"
    Cells(2, 2) = "何炅"
    Cells(2, 3) = "技术部"
    Cells(3, 1) = "A13"
    Cells(3, 2) = "赵薇"
    Cells(3, 3) = "开发部"
    Cells(4, 1) = "A14"
    Cells(4, 2) = "黄渤"
    Cells(4, 3) = "发展部"
    Cells(5, 1) = "A15"
    Cells(5, 2) = "胡歌"
    Cells(5, 3) = "销售部"
    
    '调整格式
    
    With Range("a1:d1")
        .Font.Size = 16
        .Font.Bold = True
        .Interior.ColorIndex = 15 '设置背景颜色
        .HorizontalAlignment = xlCenter
    End With
    
    With Range("a2:d5")
        .RowHeight = 93  '行高93
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    Range("d:d").ColumnWidth = 13 '照片列宽13
    
    Range("a1:d5").Borders.LineStyle = 1
    ActiveWindow.DisplayGridlines = False
End Sub

• .RowHeight 设置行高
• .ColumnWidth 设置列宽

---

二、插入图片

Sub 指定单元格位置插入图片()
    Dim strPic As String
    Dim i, n As Integer
    
    n = 1000 '预设查询1000个位置
    
    For i = 2 To Range("b" & n).End(xlUp).Row
        strPic = ThisWorkbook.Path & "\2018-09-30 指定单元格位置批量插入图片例图\" & Range("b" & i) & ".jpg"
        If Dir(strPic) <> "" Then
            ActiveSheet.Shapes.AddPicture strPic, True, True, 157, 21 + (i - 2) * 93, 81, 92
        End If
                
    Next
    
End Sub

• .Shapes.AddPicture 插入对象，链接到文件，一起保存，左上角位置，顶端位置，宽度，高度

Dir函数，用于判断文件是否存在；
Shapes.AddPicture 插入图片。

---

三、删除图片

Sub 删除所有图片()
Dim Shp As Shape

For Each Shp In ActiveSheet.Shapes
    If Shp.Type = msoLinkedPicture Then Shp.Delete

Next

End Sub

1 首先定义Shp是Shape形状类型；
2 然后定位，Shp在激活的表里，归属于Shapes其中一员；
3 循环判断，如果Shp的类型是链接图片类型，则删除Shp文件；
4 Shap类型参考，可以使用参数名，也可使用参数值。

Shap类型参考图