分享

三分钟学会excel批量插入图片

 VBA说 2020-04-07

插入图片



有位朋友咨询如何根据条件在excel表格中指定位置插入图片。

这节课给大家分享插入图片的技巧。

案例分析:要求在G列输入产品名称后,在a~f列插入对应图片。有可能一个名称对应几张照片1和2等等......

主要知识点:Addpicture函数

照片文件夹:

实现代码:难点在于模糊匹配的实现有点难度。否则代码不会这么长。

Sub 写入照片()

Application.ScreenUpdating = False

    Dim arr(), brr()

    For Each shap In Sheet1.Shapes

        If shap.Type <> 8 Then shap.Delete

    Next shap

    Bname = Dir(ThisWorkbook.Path & "\图库\" & "*.jpg") '图片路径

    Do While Len(Bname) <> 0

        k = k + 1

        ReDim Preserve arr(1 To k)

        arr(k) = Left(Bname, Len(Bname) - 4) '将图片名写入数组

        Bname = Dir

    Loop

    For Each rg In Range([g2], Cells(Rows.Count, "g"))

        If rg.Value <> "" Then '如果单元格不为空,则做循环

        a = 0

        For i = 1 To UBound(arr)  '对每个图片名做循环

            If arr(i) Like rg.Value & "*" Then   '如果单元格的值在图片名的数组中能够找到类似的,则将满足条件的图片名arr写入新的数组

            a = a + 1

            flname = ThisWorkbook.Path & "\图库\" & arr(i) & ".jpg"

            Set rg1 = Cells(rg.Row, a)

            rg1.RowHeight = 100 '初期设定单元格高和宽

            rg1.ColumnWidth = 20

            Sheet1.Shapes.AddPicture flname, True, True, rg1.Left, rg1.Top, rg1.Width, rg1.Height'插入图片,核心语句

        Else

        End If

    Next

Else

End If

Next

Application.ScreenUpdating = True

End Sub

效果:

    转藏 分享 献花(0

    0条评论

    发表

    请遵守用户 评论公约

    类似文章 更多