Excel 批量导入图片并根据单元格自动调节大小

btharp

发布于 2021-08-31 16:39:06

3.7K00

代码可运行

文章被收录于专栏：PowerBI x PythonPowerBI x Python

运行总次数：0

代码可运行

我们在《如何批量获取Excel图片并准确重命名？》一文中提到一个场景，即excel表中至少有两列，一列是图片，另一列是对应的图片名称，我们希望批量地提取当中的图片，并根据对应列为图片重命名。为解决这个问题，我们提供了Python和VBA两种实现办法。该文还将Python脚本封装成小工具给大家下载使用。

本文则对上述场景做了一个闭环，即如何根据某列名称，批量导入对应名称的图片。如果不使用Python，那么常见的也有两种做法。

方法一：

步骤一：

将下方核心公式复制到需要添加图片的列：

="<table><img src=""G:\Learning\提取excel图片\图片"&A3&".jpg""width=""180""height=""180"">"

步骤二：

桌面新建记事本，将上述D列复制过去，如下图所示：

步骤三：

复制记事本这几行，回到Excel，右键，选择性粘贴，选Unicode 文本即可。

点评：

好处：几乎不用代码，容易操作。

不足：可复用性低，每次要重复上述三步。

而且由于批量导入的图片尺寸是统一的，如果原图尺寸大小不一，就造成图片变形。

方法二：

使用VBA代码。核心代码如下：

    For k = Start_Row To Cnt
        '插入图片
        On Error Resume Next
        
        F_jpg = Cells(k, Item_Col) & ".jpg"
        F_png = Cells(k, Item_Col) & ".png"
        F_default = "None.jpg"
        
        If Dir(MyDir & F_jpg) <> "" Then
            F = F_jpg
        ElseIf Dir(MyDir & F_png) <> "" Then
            F = F_png
        Else
            F = F_default
        End If
        
        Set pic = ActiveSheet.Pictures.Insert(MyDir & F)
        '锁定高宽比
        pic.ShapeRange.LockAspectRatio = True
        '看高宽比。如果图片高宽比高，那么调整到单元格高度，否则调整到单元格宽度
        With pic.ShapeRange
            '如果图片高宽比比单元格大，说明图片太高，只需调整图片高度
            If .Height / .Width > Cells(k, Pic_Col).Height / Cells(k, Pic_Col).Width Then
                .Height = Cells(k, Pic_Col).Height - 2
                '调整位置
                .Top = Cells(k, Pic_Col).Top + 1
                .Left = Cells(k, Pic_Col).Left + (Cells(k, Pic_Col).Width - .Width) / 2
            '如果图片高宽比比单元格小，说明图片太宽，只需调整图片宽度
            Else
                .Width = Cells(k, Pic_Col).Width - 2
                '调整位置
                .Left = Cells(k, Pic_Col).Left + 1
                .Top = Cells(k, Pic_Col).Top + (Cells(k, Pic_Col).Height - .Height) / 2
            End If
        End With
    Next k

使用步骤：

点击下图【导入图片】按钮即可。导入的图片会根据单元格自动改变大小，但维持原有长宽比例。