web-dev-qa-db-ja.com

Excelからすべての画像をエクスポートし、関連するセルから名前を付ける方法

約200行のExcelシートがあります。 200の画像と200の名前があります。すべての画像を抽出して、関連する名前を付ける必要があります。

構造は次のようになります。

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

画像ファイルの末尾は関係ありません...

すべての画像を抽出して適切な名前を付けるにはどうすればよいですか？

microsoft-excelvbaimages
5
Colin

Excelから画像を保存する簡単な方法はありませんが、PowerPointには便利なShape.Export使用できる方法。このマクロは、すべての画像とともにExcelファイルで使用する必要があります。

ファイル名が画像の左上から右に1セル下にあると想定して、すべての画像を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
4
Kyle