我有一张大约有 200 行的 Excel 表。有 200 张图片和 200 个名称。我必须提取每张图片并给出相关名称。
结构如下:
Image -> A2 Name -> B3 Image -> A5 Name -> B6 Image -> A8 Name -> B9 etc.
图像文件的结尾并不重要......
我如何提取每幅图像并给出正确的名称?
答案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