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

ExcelExcelVBA

解決したいこと

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

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

0 likes

2Answer

nak435
@nak435
- 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:のコードをそのまま利用しました。

1Like

Comments

  1. @CoconaBayashi

    Questioner

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

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

  2. @nak435

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

    不要なところもあるのですが、判断するのが難しいようなら、「全部」貼り付けて問題ないです。

  3. @CoconaBayashi

    Questioner

    @nak435
    全て貼り付けるとコンパイルエラーになってしまいました。
    該当箇所を都度削除して実行して・・・と頑張ってみたのですが次々に新しいエラーが出てしまいお手上げ状態です…

  4. @nak435

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

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

    全部貼り付けた状態でエラーになったコードの前後の箇所のスクショを貼ってもらえますか。
    差し支えない範囲で、すべてのコードを貼り付けてもらっても構いません。

  5. @nak435

    すみません。↑先の回答を訂正いたいました。

  6. @CoconaBayashi

    Questioner

    @nak435 さん
    ご返事遅くなり大変申し訳ございません。
    コードは本当にただ全文貼り付けた状態です。

    エラー箇所は以下のような状態です。
    （別モジュールを作成し、参照ページ「PicturesAndShapes module:」直後のコードを全て貼り付けています。）
    スクリーンショット 2024-01-22 111418.png

  7. @nak435

    すみませんが、上のスクショから「エラー内容」を読み取れませんでした。

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

    ちなみに、Excelのバージョン情報も教えてください。

  8. @CoconaBayashi

    Questioner

    @nak435 さん
    私の貼り付け方が良くなかったようで保存もできていなかったのですが、
    再度貼り付け直したら問題なく実行できました！

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

  9. @nak435

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

    よかったです。

    当初の目的は実現できたのでしょうか？

  10. @CoconaBayashi

    Questioner

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

    原因お分かりになりますでしょうか。

  11. @nak435

    オブジェクトが無効ですのようなエラーダイアログが表示されませんか？
    それとも、SavePictureでエラーになっていますか？　その時のErr.NumberとErr.Discriptionを確認できますか。

  12. @CoconaBayashi

    Questioner

    @nak435 さん
    特にエラーメッセージのポップアップは表示されませんがデバッグで確認したところ、
    Err.Numberは「1004」、
    Err.Discriptionは「アプリケーション定義またはオブジェクト定義のエラーです」
    が入っておりました。
    2周目以降はErr.Numberが0になります。

  13. @nak435

    一時的に、On Error Resume NextとOn Error Goto -1をコメント化して、どの行でエラーが起きていうか特定することはできますか？
    （変数を特定し、その変数を設定している元を辿って、根源を見つける。）

  14. @CoconaBayashi

    Questioner

    @nak435 さん
    特定できました！
    しょうもないミスでした、お騒がせしてすみません。
    無事当初の目的達成しました！
    長くなってしまいましたがありがとうございました！

  15. @nak435

    よかったですね✌️

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

YottyPG
@YottyPG

調べた感じ、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
0Like

Comments

  1. @CoconaBayashi

    Questioner

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

Your answer might help someone💌

LoginSign Up