Excel 同时添加很多图片

Excel 同时添加很多图片

在实际Excel加载多个图片时，通常是如下图这样的，显得堆在一起，很凌乱。

但在实际工作中，有些编辑情景需要同时加载更多图片，几十张，甚至几百张。

一次性加载很多图片时，众图片堆积在一起

---

比如工厂仓库备件整理时，经常需要进行详细的图文说明。这里就需要像下图一样，很规整地在Excel中加载众多图片，然后才能很方便地在相对应的后一个单元格内输入说明内容。

一次性同时加载多个图片时的理想状态

---

当然，在图片很少的时候，并不会显得很麻烦，但如果数量很多，那给我们的工作带来的麻烦可想而知。

那有没有一个很有用的方法来很方便地去规整地加载很多图片呢。

在Excel本身自带的菜单操作上，我并没有发现有用的功能实现步骤（有知道的，分享下吧），我在处理这个问题时，采用的是写VBA 宏的方式。

新建一个VBA模块，复制如下代码：

Public Function LP() As String
    On Error Resume Next
    '------------------------------------------定义公共变量
    Dim tu As Shape
    Dim Ws As Worksheet
    Set Ws = Worksheets.Application.ActiveSheet
    '------------------------------------------删除活动表上的多余图表图像
    For Each tu In Ws.Shapes
        tu.Delete
    Next
    '-----------------------------------------将单元格大小设置成合适大小
    Columns("A:A").ColumnWidth = 22.25
    Rows("1:65535").RowHeight = 75
    '-----------------------------------------打开文件夹，选择文件
    Dim Count As Integer, H As Integer, W As Integer
    Count = 0
    Dim fd As FileDialog, Path
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
         '.InitialFileName = Range("F1").Value & ""
         .AllowMultiSelect = True
        If .Show = -1 Then
            For Each Path In .SelectedItems '---添加图片
                Count = Count + 1
                H = Cells(Count, 1).Height
                W = Cells(Count, 1).Width
                Set tu = Ws.Shapes.AddPicture(Path, msoTrue, msoTrue, 0, (Count - 1) * H, W, H)
                With tu
                    .Name = "Tu" & Ptr
                    .Placement = xlMoveAndSize
                End With
            Next
        End If
    End With
    LP = "共加载图片：" & Count & " 个"
End Function

如上代码准备妥当后，然后在工作表任意位置输入公式 “=LP()”

恭喜，一个上午可能都头疼的问题，在此仅仅是一个公式。

端上咖啡吧

 

QQ群 625157714 微博 https://weibo.com/u/1784637410

---