こんにちは。
Excel VBA で実現したい処理があるのですが行き詰っています。
どなたかお分かりになる方いらっしゃいましたらお力添えいただけますと幸いです。
具体的に実行したい処理内容は以下の通りです。
【概要】
Excelワークブック上の画像を、
画像の隣の列の指定したセル内の値で画像ファイルとして保存したい
【詳細】
商品説明が載ったExcelファイルがあります。
商品説明は決まったフォーマットでA1:A16に画像が入っていて、
B、Cに商品説明が記載されています。
ただし商品によっては画像がありません。
（画像参照）
商品画像を、商品コードがファイル名となるように保存したいと思っています。
商品によっては画像が無いため、例えば
For Each sp In ActiveSheet.Shapes
では、ファイル名とすべき値が入っているセルを正しく指定するロジックが
思いつきませんでした。
諸々試したり調べたりしたのですが、
画像をコピーして、コピーした画像を名前を指定して保存する方法がどうしてもわからず…
拙い説明で大変恐縮ですがご教示いただけますと幸いです。
よろしくお願いいたします。
画像の座標から、座標の左上のセル位置を求め、そのセルを基準にファイル名のセルを求めてはどうでしょうか。
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は、↓こちらのサイトのコードを使用しています。
@CoconaBayashi
Questioner@nak435 さん
ありがとうございます。
画像の頭がA1～A16のどこにあるか定まっていないのがネックですが
何とか完成できそうです！
勉強不足で申し訳ないのですが、
SavePicture sp.PictureFormat, "ファイルパス名.jpg"
の処理ですが、「型が一致しません」というエラーが出てしまい
解消できずにいます…
（ファイルパス名はString型の変数で設定しています）
お手数おかけして申し訳ないのですが、
何がエラーの原因になっているかおわかりでしょうか。
SavePicture sp.PictureFormat, "ファイルパス名.jpg"
の処理ですが、「型が一致しません」というエラーが出てしまい
解消できずにいます…
提案しておきながら大変申し訳ありませんが、Office365のExcelには、SavePictureが無くて確認できませんでした。F1（ヘルプ）等で、引数を確認してもらえないでしょうか。
もし、なんともならないようなら、再度Q&A上げてください。
画像の頭がA1～A16のどこにあるか定まっていないのがネックです
一つの商品につき 必ず17行固定であるなら、項目Jのセル位置は計算で求められますね。
@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を上げます。
横から失礼します。再度、Q&Aをたてたようですから、こちらの質問はクローズするといいですよ。
全然違うアプローチとして、Excelワークブックの中に格納されているイメージデータを、そのままいただく方法もあります。
手順は以下の通り。
.xlsxから.zipへリネームするxl\media\*.png が画像データ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
@CoconaBayashi
Questioner@nak435 さん
別の切り口のご提案までありがとうございます！
画像をvbaから保存する方法がうまく行かなかったらこちらで何とかしようと思います。
大変勉強になります。
本当にありがとうございます。
@CoconaBayashi
Questioner@nak435
一応ご報告なのですが、shape.nameで取得できる名前は
.zip変換→解凍で取り出せる画像の名前と一致しませんでした…
色々教えていただいているのに申し訳ございません…
一応ご報告なのですが、shape.nameで取得できる名前は
.zip変換→解凍で取り出せる画像の名前と一致しませんでした…
そうなんですよ。数字部分も一致しませんでしたか？
@CoconaBayashi
Questioner@nak435 さん
画像によっては「～.jpg」まで表示されたり、日本語で「図形４」などと表示されたり揺れがあるところが不思議でした…
数字については一致していたのですが、zip化して取り出した画像との突合をどうしようかなというところですね…
xl\drawing\drawing1.xmlにヒントありませんかね？