如何从 Excel 导出所有图像并从相关单元格中命名

Question

我有一个大约 200 行的 Excel 表格。有 200 张图像和 200 个名称。我必须提取每个图像并给出相关名称。

结构是这样的：

Image -> A2 Name -> B3 Image -> A5 Name -> B6 Image -> A8 Name -> B9 etc.

图像文件的结尾无关紧要...

如何提取每个图像并给出正确的名称？

Answer 1

从 Excel 中保存图像没有简单的方法，但 PowerPoint 有一个Shape.Export我们可以使用的便捷方法。该宏应该在包含所有图像的 Excel 文件中使用。

它将所有图像保存在 Sheet1 上，假设它们的文件名是图像左上方向右下方一个单元格。确保destFolder在第一行编辑到正确的位置。它会在不询问的情况下覆盖任何现有文件，因此请小心。

Sub SaveImages()

    'the location to save all the images
    Const destFolder$ = "C:\users\...\desktop\"

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("sheet1")

    Dim ppt As Object, ps As Variant, slide As Variant

    Set ppt = CreateObject("PowerPoint.application")
    Set ps = ppt.presentations.Add
    Set slide = ps.slides.Add(1, 1)

    Dim shp As Shape, shpName$
    For Each shp In ws.Shapes
        shpName = destFolder & shp.TopLeftCell.Offset(1, 1) & ".png"
        shp.Copy
        With slide
            .Shapes.Paste
            .Shapes(.Shapes.Count).Export shpName, 2
            .Shapes(.Shapes.Count).Delete
        End With
    Next shp

    With ps
        .Saved = True
        .Close
    End With
    ppt.Quit
    Set ppt = Nothing

End Sub