[Q&A] Excel VBA 画像保存方法について

Excel VBA 画像保存方法について

解決したいこと

【SavePicture を利用して、ワークシート上の画像を保存】

excel VBAを使用して、ワークシート上にある画像を保存したいのですが
「型が一致しません」というエラーが出てしまい、解決できずにいます。

私のExcelの設定やバージョンに原因があるのか、
コードの書き方の問題かの切り分けすらできず困っております。

お分かりになる方いらっしゃいましたらご教示いただけますと幸いです。

実行したコードは以下の通りです。

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"
    MsgBox "画像が保存されました！"
End Sub

自分で試したこと

もともとshape型の変数にワークシート上の画像を１つずつ格納し
任意の名前を付けて保存する処理を書いていたのですが、
保存のロジックがどうしてもうまく行かず詰まってしまいました。

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

2Answer

@nak435 posted at 2024-01-17

- Set img = Sheets("test").Shapes(1).PictureFormat
+ Set img = Sheets("test").Shapes(1).DrawingObject

SavePicture の第一引数が IPictureDisp なので、Picture なら出来るかと思いましたが、ダメでした。

ネットを探したところ、下記サイトにあったコードを利用するとセーブできることを確認しました。

Sub SaveImage()
    Dim shp As Shape
    On Error Resume Next
    Set shp = Sheets("test").Shapes(1)
    If Err.Number = 0 Then
        On Error GoTo -1
        SavePicture PictureFromShape(shp), ThisWorkbook.Path & "\testpic.jpg"
        MsgBox "画像が保存されました！"
    End If
    On Error GoTo -1
End Sub

関数PictureFromShapeは、下記サイトの中央あたりにあるPicturesAndShapes module:のコードをそのまま利用しました。

Comments

@CoconaBayashi
Questioner
@nak435 さん
ご回答ありがとうございます。
頂いた回答を参考にやってみたのですが、PicturesAndShapes module:をどこまでを貼れば良いかわからず上手くいきませんでした…
（PictureFromShape()関数の定義の部分を貼り付ければ良いのかと思ったのですが
違うのですね…）
私の知識レベルでは解決できなさそうなので以前に上げたA&Qでご提案いただいた方法を試してみようと思います。

ありがとうございました。
@nak435

PictureFromShape()関数の定義の部分を貼り付ければ良いのかと思ったのですが
違うのですね…

不要なところもあるのですが、判断するのが難しいようなら、「全部」貼り付けて問題ないです。
@CoconaBayashi
Questioner
@nak435
全て貼り付けるとコンパイルエラーになってしまいました。
該当箇所を都度削除して実行して・・・と頑張ってみたのですが次々に新しいエラーが出てしまいお手上げ状態です…
@nak435

全て貼り付けるとコンパイルエラーになってしまいました。

もしかして、それは、前回のQ&Aで外部サイトから貼り付けたコードが残っていませんか？
そちらはもう使いませんので、そちらのコードは全部削除してください。

全部貼り付けた状態でエラーになったコードの前後の箇所のスクショを貼ってもらえますか。
差し支えない範囲で、すべてのコードを貼り付けてもらっても構いません。
@nak435
すみません。↑先の回答を訂正いたいました。
@CoconaBayashi
Questioner
@nak435 さん
ご返事遅くなり大変申し訳ございません。
コードは本当にただ全文貼り付けた状態です。

エラー箇所は以下のような状態です。
（別モジュールを作成し、参照ページ「PicturesAndShapes module:」直後のコードを全て貼り付けています。）
@nak435
すみませんが、上のスクショから「エラー内容」を読み取れませんでした。

実行時のエラーではありませんか？

ちなみに、Excelのバージョン情報も教えてください。
@CoconaBayashi
Questioner
@nak435 さん
私の貼り付け方が良くなかったようで保存もできていなかったのですが、
再度貼り付け直したら問題なく実行できました！

画像が保存されることも確認できました。
解決するまで辛抱強くご対応いただき本当にありがとうございました。
@nak435

再度貼り付け直したら問題なく実行できました！

よかったです。

当初の目的は実現できたのでしょうか？
@CoconaBayashi
Questioner
@nak435 さん
大体できました。
ただし１つ問題がございまして、こちらについて図々しくも質問してしまうのですが、
１つ目の画像のみ保存されません。
具体的には全ての画像を保存するようにコードを変えてみたのですが、
1ループ目の時だけ、画像選択箇所の「On Error GoTo -1」に引っかかり、
画像が保存されません。
（コードが汚くてすみません）

原因お分かりになりますでしょうか。
@nak435
オブジェクトが無効ですのようなエラーダイアログが表示されませんか？
それとも、SavePictureでエラーになっていますか？　その時のErr.NumberとErr.Discriptionを確認できますか。
@CoconaBayashi
Questioner
@nak435 さん
特にエラーメッセージのポップアップは表示されませんがデバッグで確認したところ、
Err.Numberは「1004」、
Err.Discriptionは「アプリケーション定義またはオブジェクト定義のエラーです」
が入っておりました。
2周目以降はErr.Numberが0になります。
@nak435
一時的に、On Error Resume NextとOn Error Goto -1をコメント化して、どの行でエラーが起きていうか特定することはできますか？
（変数を特定し、その変数を設定している元を辿って、根源を見つける。）
@CoconaBayashi
Questioner
@nak435 さん
特定できました！
しょうもないミスでした、お騒がせしてすみません。
無事当初の目的達成しました！
長くなってしまいましたがありがとうございました！
@nak435
よかったですね✌️

当Q&Aはクローズして、
今後もし何かあれば、改めてQ&Aしてください。

@YottyPG posted at 2024-01-18

調べた感じ、SavePictureはフォーム内のコントロールに紐づく画像などにしか使えなさそうでした。

チャートであれば画像として保存することができるようなので、
以下のような形で、一度チャートに画像を貼り付けて、そのチャートを画像として保存すれば実現できそうです。

ただ、このやり方だと多少画質は落ちてしまうと思います…。

Sub SaveImage()
    Set img = Sheets("sheet1").Shapes(1)
    img.CopyPicture
    ACWidth = img.Width
    ACHeight = img.Height
    Set TCht = ActiveSheet.ChartObjects.Add(0, 0, ACWidth, ACHeight).Chart
    TCht.ChartArea.Format.Line.Visible = msoFalse
    TCht.Parent.Activate
    TCht.Paste
    TCht.Export Filename:=ThisWorkbook.Path & "\testpic.jpg", filtername:="JPG"
    TCht.Parent.Delete
    
    MsgBox "画像が保存されました！"
End Sub

Comments

@CoconaBayashi
Questioner
@YottyPG
御回答ありがとうございます。
なるほど、むしろチャートにしてしまうんですね。
参考にさせていただきます。
大変助かります。ありがとうございます。

Excel VBA 画像保存方法について

解決したいこと

実行したコードは以下の通りです。

自分で試したこと

2Answer

Comments

Comments

Your answer might help someone💌

Popular Questions