Как экспортировать все изображения из Excel и дать имя из связанной ячейки

Question

У меня есть лист Excel с около 200 строк. Есть 200 изображений и 200 имен. Я должен извлечь каждое изображение и дать соответствующее имя.

Структура выглядит так:

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

Окончание файла изображения не имеет значения ...

Как извлечь каждое изображение и дать правильное имя?

Answer 1

Нет простого способа сохранить изображения из Excel, но PowerPoint имеет удобную Shape.Export мы можем использовать. Этот макрос должен использоваться в вашем файле Excel со всеми изображениями.

Он сохраняет все изображения на Листе 1, предполагая, что их имя файла находится на одну ячейку вниз и справа от верхнего левого угла изображения. Обязательно отредактируйте 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