您当前的位置:首页 > 电脑百科 > 软件技术 > office

Excel插入批量图片,套用这些代码就OK

时间:2020-08-12 09:36:41  来源:  作者:

以下文章来源于VBA编程学习与实践 ,作者EH看见星光

咱们今天分享的内容是按指定名称和位置批量将图片插入到Excel工作表中……

看个动画先:

Excel插入批量图片,套用这些代码就OK

 

代码如下

Sub InsertPic()
    'ExcelHome VBA编程学习与实践 by:看见星光
    Dim Arr, i&, k&, n&, pd&
    Dim strPicName$, strPicPath$, strFdPath$, shp As Shape
    Dim Rng As Range, Cll As Range, Rg As Range, strWhere As String
    'On Error Resume Next
    '用户选择图片所在的文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
       If .Show Then strFdPath = .SelectedItems(1) Else: Exit Sub
    End With
    If Right(strFdPath, 1) <> "" Then strFdPath = strFdPath & ""
    Set Rng = Application.InputBox("请选择图片名称所在的单元格区域", Type:=8)
    '用户选择需要插入图片的名称所在单元格范围
    Set Rng = Intersect(Rng.Parent.UsedRange, Rng)
    'intersect语句避免用户选择整列单元格,造成无谓运算的情况
    If Rng Is Nothing Then MsgBox "选择的单元格范围不存在数据!": Exit Sub
    strWhere = InputBox("请输入图片偏移的位置,例如上1、下1、左1、右1", , "右1")
    '用户输入图片相对单元格的偏移位置。
    If Len(strWhere) = 0 Then Exit Sub
    x = Left(strWhere, 1)
    '偏移的方向
    If InStr("上下左右", x) = 0 Then MsgBox "你未输入偏移方位。": Exit Sub
    y = Val(Mid(strWhere, 2))
    '偏移的值
    Select Case x
        Case "上"
        Set Rg = Rng.Offset(-y, 0)
        Case "下"
        Set Rg = Rng.Offset(y, 0)
        Case "左"
        Set Rg = Rng.Offset(0, -y)
        Case "右"
        Set Rg = Rng.Offset(0, y)
    End Select
    Application.ScreenUpdating = False
    Rng.Parent.Select
    For Each shp In ActiveSheet.Shapes
    '如果旧图片存放在目标图片存放范围则删除
        If Not Intersect(Rg, shp.TopLeftCell) Is Nothing Then shp.Delete
    Next
    x = Rg.Row - Rng.Row
    y = Rg.Column - Rng.Column
    '偏移的坐标
    Arr = Array(".jpg", ".jpeg", ".bmp", ".png", ".gif")
    '用数组变量记录五种文件格式
    For Each Cll In Rng
    '遍历选择区域的每一个单元格
        strPicName = Cll.Text
        '图片名称
        If Len(strPicName) Then
        '如果单元格存在值
            strPicPath = strFdPath & strPicName
            '图片路径
            pd = 0
            'pd变量标记是否找到相关图片
            For i = 0 To UBound(Arr)
            '由于不确定用户的图片格式,因此遍历图片格式
                If Len(Dir(strPicPath & Arr(i))) Then
                '如果存在相关文件
                    Set shp = ActiveSheet.Shapes.AddPicture( _
                        strPicPath & Arr(i), False, True, _
                        Cll.Offset(x, y).Left + 5, _
                        Cll.Offset(x, y).Top + 5, _
                        20, 20)
                    shp.Select
                    With Selection
                        .ShapeRange.LockAspectRatio = msoFalse
                        '撤销锁定图片纵横比
                        .Height = Cll.Offset(x, y).Height - 10 '图片高度
                        .Width = Cll.Offset(x, y).Width - 10 '图片宽度
                    End With
                    pd = 1 '标记找到结果
                    n = n + 1 '累加找到结果的个数
                    [a1].Select: Exit For '找到结果后就可以退出文件格式循环
                End If
            Next
            If pd = 0 Then k = k + 1 '如果没找到图片累加个数
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "共处理成功" & n & "个图片,另有" & k & "个非空单元格未找到对应的图片。"
End Sub
Excel插入批量图片,套用这些代码就OK

 

代码已有注释说明,这儿就再说明一下运行过程。

首先,会让用户选择存放图片的文件夹。注意是选择文件夹,不是选择图片;选择文件夹后,看不到文件夹内的图片是正常现象。

Excel插入批量图片,套用这些代码就OK

 

然后,选择图片名称存放的单元格区域,可以选择整列、多列、整行或多行,比如示例动画中的B:D列,2:2行等。。

Excel插入批量图片,套用这些代码就OK

 

最后,设置图片相对于图片名称所在的单元格便宜的位置;比如图片名称在B列,图片放在C列,那就是向右偏移1列,即右1。上下左右代表了方向,数字代表偏移的量。

Excel插入批量图片,套用这些代码就OK

 

小贴士:

1,该段小代码支持一下图片格式:

".jpg", ".jpeg", ".bmp", ".png", ".gif"

2,图片的纵横比是未锁定的,如需锁定,可以注释掉下句代码:

.ShapeRange.LockAspectRatio = msoFalse

3,图片的行高和列宽是由放置图片的单元格行高和列宽决定的。当然,您也可以把代码稍微修改,设置固定的图片行高和列宽,并由图片的行高和列宽决定单元格的大小。

4,图片的名称必须和指定单元格范围内的名称一致,如果需要模糊匹配,使用DIR函数搭配通配符的方式即可。

5,代码采用非引用的方式插入图片,该方式会图片作为excel的资源打包到excel文件中,即便数据源的图片已被删除,表格中的图片也依然存在。



Tags:Excel插入批量图片   点击:()  评论:()
声明:本站部分内容及图片来自互联网,转载是出于传递更多信息之目的,内容观点仅代表作者本人,如有任何标注错误或版权侵犯请与我们联系(Email:2595517585@qq.com),我们将及时更正、删除,谢谢。
▌相关推荐
以下文章来源于VBA编程学习与实践 ,作者EH看见星光咱们今天分享的内容是按指定名称和位置批量将图片插入到Excel工作表中&hellip;&hellip;看个动画先: 代码如下Sub InsertPic(...【详细内容】
2020-08-12  Tags: Excel插入批量图片  点击:(145)  评论:(0)  加入收藏
▌简易百科推荐
Excel常用电子表格公式大全   一、Excel基本公式   1、查找重复内容公式:=IF(COUNTIF(A:A,A2)>1,"重复","")。   2、用出生年月来计算年龄公式:=TRUNC((DAYS360(H6,"200...【详细内容】
2021-12-21  楠方儿i    Tags:Excel   点击:(11)  评论:(0)  加入收藏
最近这段时间,我们三易生活收到了一些来自读者朋友的求助,在他们选购电脑时发现,有的设备出厂预装了“Microsoft 365”,而另一些则预装的是“Office 2021”。对于这两款同为微软...【详细内容】
2021-12-14  三易生活    Tags:Office   点击:(26)  评论:(0)  加入收藏
我们在做问卷调差或者填写一些资料表的时候,会遇到一些word文档中有小方框【□】,需要在里面打钩【&radic;】,那么是如何操作呢,今天和大家分享一下。方法一1,打开我们需要操作...【详细内容】
2021-11-26  小七哆来咪发唆    Tags:word   点击:(36)  评论:(0)  加入收藏
试想一下,用 Excel 管理项目的时候,会有很严格的日期安排,而且项目中的各细目经常是并行作业的,这就意味着日期不一定是排序的 。 那么事项太多如何更好管理,而不至于遗忘关键节...【详细内容】
2021-11-16  Excel学习世界    Tags:Excel   点击:(22)  评论:(0)  加入收藏
与大家分享一下有关制作身份证电子版时四周圆角处理的具体方法。方法/步骤首先,我们利用WPS打开相应的身份证扫描件,选中图片,点击“裁剪图片”按钮。 此时将显示“裁剪方式”...【详细内容】
2021-11-09  数字传媒微课堂    Tags:身份证   点击:(196)  评论:(0)  加入收藏
WPS是我们的常用办公软件之一,很多人在使用WPS打印功能的时候,经常会遇到多种多样的打印小问题,今天就为大家简单讲解下打印面板的各个小功能的作用。打印文档方法: 在左上角“W...【详细内容】
2021-11-02    21世纪教育网  Tags:WPS   点击:(31)  评论:(0)  加入收藏
前言:说起办公,就会想到三大办公软件,Word、Excel、PPT。这些软件的使用是有技巧的,学会使用技巧工作效率就会提高,加班自然就能避免。 今天就来分享其中之一:Word办公的7个小技巧...【详细内容】
2021-11-02  小杰好厉害呀    Tags:Word   点击:(52)  评论:(0)  加入收藏
我们使用 Word 的时候,页面上通常会有一些默认的符号,平时大家司空见惯了,可能没有多加留意,更不知道如何去除这些符号。 今天教大家两个 Word 技巧,将 Word 中默认的一些标记符...【详细内容】
2021-11-01  Excel学习世界    Tags:Word   点击:(48)  评论:(0)  加入收藏
经常用 Excel 的表哥表姐们,想必都知道「下拉菜单」这个神器,鼠标点点点,就能轻轻录入数据:▲ 一级下拉菜单 它的制作方法也很简单,用【数据验证】功能可以直接实现! 有小伙伴表示...【详细内容】
2021-10-27  秋叶Excel    Tags:Excel   点击:(41)  评论:(0)  加入收藏
在工作中, 我们需要对业务人员的业绩进行跟进,会有如下格式的跟进表 每天要进行更新表格的时候,表头都要重新手动的进行输入,比较麻烦,今天教大家的技巧是使用公式进行自动更新首...【详细内容】
2021-10-26  Excel自学成才    Tags:   点击:(41)  评论:(0)  加入收藏
相关文章
    无相关信息
最新更新
栏目热门
栏目头条