LoginSignup
@CoconaBayashi

Are you sure you want to delete the question?

If your question is resolved, you may close it.

Leaving a resolved question undeleted may help others!

We hope you find it useful!

Excel VBA　画像を画像ファイルとして保存

Q&A

ExcelVBA

セル上の画像を画像ファイルとして保存したい

こんにちは。
Excel VBA で実現したい処理があるのですが行き詰っています。
どなたかお分かりになる方いらっしゃいましたらお力添えいただけますと幸いです。

具体的に実行したい処理内容は以下の通りです。

【概要】
Excelワークブック上の画像を、
画像の隣の列の指定したセル内の値で画像ファイルとして保存したい

【詳細】
商品説明が載ったExcelファイルがあります。
商品説明は決まったフォーマットでA1:A16に画像が入っていて、
B、Cに商品説明が記載されています。
ただし商品によっては画像がありません。
（画像参照）

Excelファイルイメージ.png

商品画像を、商品コードがファイル名となるように保存したいと思っています。

発生している問題・エラー

商品によっては画像が無いため、例えば

For Each sp In ActiveSheet.Shapes

では、ファイル名とすべき値が入っているセルを正しく指定するロジックが
思いつきませんでした。

自分で試したこと

諸々試したり調べたりしたのですが、
画像をコピーして、コピーした画像を名前を指定して保存する方法がどうしてもわからず…

拙い説明で大変恐縮ですがご教示いただけますと幸いです。

よろしくお願いいたします。

0 likes

2Answer

nak435
@nak435

画像の座標から、座標の左上のセル位置を求め、そのセルを基準にファイル名のセルを求めてはどうでしょうか。

Sub example()
    Dim sp As Shape, rg As Range
    For Each sp In ActiveSheet.Shapes
        Set rg = Point2Cell(ActiveSheet, sp.Left, sp.Top)
        'Debug.Print rg.Row, rg.Column
        'ファイル名のセル位置を求める
        SavePicture sp.PictureFormat, "ファイルパス名.jpg"
    Next
End Sub

関数Point2Cellは、↓こちらのサイトのコードを使用しています。

1Like

Comments

  1. @CoconaBayashi

    Questioner

    @nak435 さん
    ありがとうございます。
    画像の頭がA1～A16のどこにあるか定まっていないのがネックですが
    何とか完成できそうです！

    勉強不足で申し訳ないのですが、

    SavePicture sp.PictureFormat, "ファイルパス名.jpg"

    の処理ですが、「型が一致しません」というエラーが出てしまい
    解消できずにいます…
    （ファイルパス名はString型の変数で設定しています）

    お手数おかけして申し訳ないのですが、
    何がエラーの原因になっているかおわかりでしょうか。

  2. @nak435

    SavePicture sp.PictureFormat, "ファイルパス名.jpg"
    の処理ですが、「型が一致しません」というエラーが出てしまい
    解消できずにいます…

    提案しておきながら大変申し訳ありませんが、Office365のExcelには、SavePictureが無くて確認できませんでした。F1（ヘルプ）等で、引数を確認してもらえないでしょうか。
    もし、なんともならないようなら、再度Q&A上げてください。

    画像の頭がA1～A16のどこにあるか定まっていないのがネックです

    一つの商品につき 必ず17行固定であるなら、項目Jのセル位置は計算で求められますね。

  3. @CoconaBayashi

    Questioner

    @nak435 さん
    ご返事ありがとうございます。
    引数確認したのですが、(Picture As IPictureDisp,filename As String)となっており、問題ないのでは…と思いますが如何でしょうか。

    https://www.helpaso.net/course/excel_vba/statement/savepicture/
    またこちらのページを参考し、コードお借りして

    Sub SaveImage()
    Dim img As Object
    Set img = Sheets("test").Shapes(1).PictureFormat
    SavePicture img, ThisWorkbook.Path & "\testpic.jpg"
End Sub

    を実行してみたのですが、やはり「型が一致しません」というエラーが出てしまいました。
    私のエクセル側の問題ですかね…
    改めて別の質問として再度Q&Aを上げます。

  4. @jinbei230525

    横から失礼します。再度、Q&Aをたてたようですから、こちらの質問はクローズするといいですよ。

nak435
@nak435

全然違うアプローチとして、Excelワークブックの中に格納されているイメージデータを、そのままいただく方法もあります。

手順は以下の通り。

  1. 該当のExcelワークブック（例えば、SYOUHIN.xlsx）をどこかにコピーする
  2. コピーしたファイルの拡張子を.xlsxから.zipへリネームする
  3. リネームしたファイル SYOUHIN.zip を解凍する
  4. 解凍してできたフォルダ配下の xl\media\*.png が画像データ
     （おそらく、image1.png, image2.png, ・・・）
  5. 画像データのファイル名に付いている数字が、画像shapeのnameの数字と同じと思われる
    （下記のVBAコードで確認してください）
  6. ちなみに、xl\drawing\drawing1.xmlに、画像shapeのnameとセル位置が定義されていますが、これ自体をVBAで処理するのは、面倒そうです。
Sub example()
    Dim sp As Shape, rg As Range
    For Each sp In ActiveSheet.Shapes
        Set rg = Point2Cell(ActiveSheet, sp.Left, sp.Top)
        Debug.Print "row:"; rg.Row, "col:"; rg.Column, "shape_name: "; sp.Name
    Next
End Sub

row: 3        col: 2        shape_name: Picture 1
row: 11       col: 2        shape_name: Picture 2
0Like

Comments

  1. @CoconaBayashi

    Questioner

    @nak435 さん
    別の切り口のご提案までありがとうございます！
    画像をvbaから保存する方法がうまく行かなかったらこちらで何とかしようと思います。
    大変勉強になります。
    本当にありがとうございます。

  2. @CoconaBayashi

    Questioner

    @nak435
    一応ご報告なのですが、shape.nameで取得できる名前は
    .zip変換→解凍で取り出せる画像の名前と一致しませんでした…

    色々教えていただいているのに申し訳ございません…

  3. @nak435

    一応ご報告なのですが、shape.nameで取得できる名前は
    .zip変換→解凍で取り出せる画像の名前と一致しませんでした…

    そうなんですよ。数字部分も一致しませんでしたか？

  4. @CoconaBayashi

    Questioner

    @nak435 さん
    画像によっては「～.jpg」まで表示されたり、日本語で「図形４」などと表示されたり揺れがあるところが不思議でした…
    数字については一致していたのですが、zip化して取り出した画像との突合をどうしようかなというところですね…

  5. @nak435

    xl\drawing\drawing1.xmlにヒントありませんかね？

Your answer might help someone💌

LoginSign Up