[[20211013095427]]　『エクセル内の画像をJPG保存』（harukaze）　ページの最後に飛ぶ

『エクセル内の画像をJPG保存』（harukaze）

 エクセルシートに挿入された画像を取り出し、フォルダにJPGとして保存したいと考えています。

 次のようなコードを見つけて一部加工しマクロを実行しましたが、保存されるJPGに画像はなく真っ白な状態となってしまいます。
 しかし、ステップイン操作でマクロを実行した場合は、正確に作動します。

 ご教授お願いいたします。

 Sub 保存()

 'ワークシートの全オブジェクトをループ
 For Each tobj In ActiveSheet.Shapes

 If tobj.Type = 13 Then 'オブジェクトが画像ならType=13となる。
 tobj.CopyPicture
 Fname = tobj.Name 'オブジェクトの名前を取得
 ACWidth = tobj.Width 'オブジェクトのサイズを取得（高さ）
 ACHeight = tobj.Height 'オブジェクトのサイズを取得（高さ）

 'オブジェクトとほぼ同サイズの空のグラフを一時的に作る

 Set TCht = ActiveSheet.ChartObjects.Add(0, 0, ACWidth * 0.8, ACHeight * 0.8).Chart

 TCht.Paste 'グラフに画像をペーストする。

  TCht.Export Filename:=ThisWorkbook.Path & "\Pic\" & Fname & ".jpg", filtername:="JPG"
 TCht.Parent.Delete 'グラフを削除する。
 End If
 Next

 End Sub

＜使用 Excel：Office365、使用 OS：Windows10 ＞

 試しに[DoEvents]でも入れてみたら、どうにかしてくれるかもですね...

    Sub 保存()
        For Each tobj In ActiveSheet.Shapes
            If tobj.Type = 13 Then
                tobj.CopyPicture
                DoEvents '★追記してみる
                Fname = tobj.Name
                ACWidth = tobj.Width
                ACHeight = tobj.Height
                Set TCht = ActiveSheet.ChartObjects.Add(0, 0, ACWidth * 0.8, ACHeight * 0.8).Chart
                TCht.Parent.Activate '★それでもダメならコイツも追記してみる
                TCht.Paste
                DoEvents '★追記してみる
                TCht.Export Filename:=ThisWorkbook.Path & "\" & Fname & ".jpg", filtername:="JPG"
                TCht.Parent.Delete
            End If
        Next
    End Sub

（白茶） 2021/10/13(水) 10:53

 白茶さま

 ご教授ありがとうございます！

 >TCht.Parent.Activate '★それでもダメならコイツも追記してみる

 ↑こちらのコードを追加しましたら、正確に作動しました。

 助かりました。本当にありがとうございます。
（harukaze） 2021/10/13(水) 11:04

コメント返信：

[ 一覧(最新更新順) ]

[[20211013095427]] 『エクセル内の画像をJPG保存』（harukaze） ページの最後に飛ぶ

[[20211013095427]]　『エクセル内の画像をJPG保存』（harukaze）　ページの最後に飛ぶ