EXCEL批量插图的几种方法(含批注插图,VBA插图,以及用插图公式插入图片)(2)

二、插图到单元格里面，直接显示
插图到单元格的，有两种方式可以选择，一种用宏，一种用公式
先说宏：
Sub 插入图片()
    Dim rng As Range, ML, MT, MW, MH, shp As Shape, Myc%, Myr&, i&, j&
    On Error Resume Next
   
    For Each shp In ActiveSheet.Shapes
        If shp.Type = msoAutoShape Then
            shp.Delete
        End If
    Next
    Myr = [c65536].End(xlUp).Row   '货号所在的列为C，如果不是在C这里自行修改一下
    Myc = [iv9].End(xlToLeft).Column
    For i = 9 To Myr Step 8    '纵向从第9行（行号9）开始插图，然后每间隔8行插入一张图片
    For j = 3 To Myc Step 1    '横向从第3列（C列)开始插图，然后每间隔1列插入一张图片
        If Cells(i, j) <> "" Then
        Set rng = Cells(i, j).Offset(0, 0)
        With rng
            ML = .Left
            MT = .Top
            MW = .Width
            MH = .Height
            ActiveSheet.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).Select
            Selection.ShapeRange.Fill.UserPicture _
                ".0.0.8文件服务器产品图库" & "" & Cells(i, j).Value & ".jpg"     '当前文件所在目录下以当前单元内容为名称的.jpg图片
        End With
        End If
    Next
    Next
    [a1].Select
    If Err.Number <> 0 Then Err.Clear: On Error GoTo 0
End Sub

Sub 删除全部图片()

Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        If shp.Type <> 8 And shp.Type <> 12 And shp.Type <> 6 Then shp.Delete
    Next

End Sub


按红色字体参数设置最终插图的区域如下图中灰色框区，参数可以按实际插图的格子分布调整




如果只需要横向或者只需要竖向，只要改里面的参数就行

竖向插图：
Sub 插入图片()
    Dim rng As Range, ML, MT, MW, MH, shp As Shape, Myc%, Myr&, i&, j&
    On Error Resume Next
   
    For Each shp In ActiveSheet.Shapes
        If shp.Type = msoAutoShape Then
            shp.Delete
        End If
    Next
    Myr = [c65536].End(xlUp).Row   '货号所在的列为C，如果不是在C这里自行修改一下
    Myc = [iv9].End(xlToLeft).Column
    For i = 9 To Myr Step 8    '纵向从第9行（行号9）开始插图，然后每间隔8行插入一张图片

        If Cells(i, 3) <> "" Then
        Set rng = Cells(i, 3).Offset(0, 0)
        With rng
            ML = .Left
            MT = .Top
            MW = .Width
            MH = .Height
            ActiveSheet.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).Select
            Selection.ShapeRange.Fill.UserPicture _
                ".0.0.8文件服务器产品图库" & "" & Cells(i, 3).Value & ".jpg"     '当前文件所在目录下以当前单元内容为名称的.jpg图片
        End With
        End If
    Next

    [a1].Select
    If Err.Number <> 0 Then Err.Clear: On Error GoTo 0
End Sub
只要将j参数改成你要插图的列号就行了，这里以第三列插图为例子，然后删除一个j参数的for next循环

横向插图：

Sub 插入图片()

    Dim rng As Range, ML, MT, MW, MH, shp As Shape, Myc%, Myr&, i&, j&

    On Error Resume Next

   

    For Each shp In ActiveSheet.Shapes

        If shp.Type = msoAutoShape Then

            shp.Delete

        End If

    Next

    Myr = [z65536].End(xlUp).Row   '货号所在的列为C,如果不是在C这里自行修改一下

    Myc = [iv3].End(xlToLeft).Column

    For j = 26 To Myc Step 1    '横向从第3列(C列)开始插图,然后每间隔1列插入一张图片

        If Cells(3, j) <> "" Then

        Set rng = Cells(3, j).Offset(0, 0)

        With rng

            ML = .Left

            MT = .Top

            MW = .Width

            MH = .Height

            ActiveSheet.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).Select

            Selection.ShapeRange.Fill.UserPicture _

                ".0.0.118文件服务器产品图库" & "" & Cells(3, j).Value & ".jpg"     '当前文件所在目录下以当前单元内容为名称的.jpg图片

        End With

        End If

    Next

    [a1].Select

    If Err.Number <> 0 Then Err.Clear: On Error GoTo 0

End Sub

从第3行，26列（z列）开始一直往右侧列插图，行数一直在第三行，


再来用公式的
使用公式：<table><img src="图片地址" width="100" height="100">
width控制图片宽度，height控制图片高度

下面案例用到的公式

<table><img src="\10.0.0.118文件服务器电商事业部内部文件H货品产品图库AAAA.jpg" width="100" height="100">

然后SUBSTITUTE($G$1,"AAAA",E6)往下拉

将公式填充到要插图的表格，图片地址自行替换，然后将所有插图公式全选-复制，然后黏贴到记事本，然后再记事本中CTRL+A全选，复制再黏贴回表格，选择性黏贴-粘贴为UNICODE文本。等加载完成就插图成功
看以下动图演示：

三、不插图，只插入图片的超链接，在表格里面点链接打开图片

使用公式：=HYPERLINK(LEFT(CELL("filename"),FIND("[",CELL("filename"))-1)&B2&".jpg",B2)

需要注意：EXCEL文件必须和产品图片放在同一个文件夹中