VBAでjpeg書き出し時白紙になる

Question

### 実現したいこと

VBAで、Excelで作成している表をjpeg画像として保存したい。

### 前提

Excelで作られた表の最終行までを自動でjpeg画像に書き出すVBAコードを完成させたい。

### 発生している問題・エラーメッセージ

今週の月曜まではうまく書き出せていたが、
それ以降、内容が反映されていない真っ白な画像が書き出されるようになってしまった。

### 該当のソースコード

Dim wsEnd As Worksheet
Dim lastRowEnd As Long
Dim rg As Range

Set wsEnd = ThisWorkbook.Sheets("最終")
lastRowEnd = wsEnd.Cells(wsEnd.Rows.Count, "A").End(xlUp).Row
Set rg = wsEnd.Range("A1:L" & lastRowEnd)

rg.CopyPicture appearance:=xlScreen, Format:=xlPicture
With New Excel.Application
     With .Workbooks.Add
         With .Worksheets(1).ChartObjects.Add(0, 0, rg.Width,
rg.Height).Chart
             .Paste
             .Export fileName:="C:\ftp\etc\mail\最終.jpg", filtername:="jpg"
         End With
         .Close False
      End With
      .Quit
End With

### 試したこと

fileNameにホルダがちゃんとあることは確認。最終.jpgも更新はされているが、白紙になっている。
白紙のサイズが変わっていることから、最終行までの範囲は取れていそうだが、なぜか中身がコピーされていないようです。

どのように直せば上手くいくか、ご教示いただけますと幸いです。

### 補足情報（FW/ツールのバージョンなど）

Windows11
office2024

Answer

原因は良くわかっていないのですが、私の環境では一応以下で出るみたいなので回答します。

```VBA
Dim wsEnd As Worksheet
Dim lastRowEnd As Long
Dim rg As Range

Set wsEnd = ThisWorkbook.Sheets("最終")
lastRowEnd = wsEnd.Cells(wsEnd.Rows.Count, "A").End(xlUp).Row
Set rg = wsEnd.Range("A1:L" & lastRowEnd)
With New Excel.Application
    With .Workbooks.Add
        With .Worksheets(1).ChartObjects.Add(0, 0, rg.Width, rg.Height).Chart
            rg.CopyPicture appearance:=xlScreen, Format:=xlPicture
            Application.Wait (Now + TimeValue("00:00:01"))
            .Paste
            Application.Wait (Now + TimeValue("00:00:01"))
            .Export Filename:="C:\Work\最終.jpg", filtername:="jpg"
        End With
        .Close False
    End With
    .Quit
End With

```

以下でも出力できるようになった気がします。

```VBA
Dim wsEnd As Worksheet
Dim wsTmp As Worksheet
Dim lastRowEnd As Long
Dim rg As Range

Set wsEnd = ThisWorkbook.Sheets("最終")
Set wsTmp = ThisWorkbook.Sheets("Sheet2")

lastRowEnd = wsEnd.Cells(wsEnd.Rows.Count, "A").End(xlUp).Row
Set rg = wsEnd.Range("A1:L" & lastRowEnd)
rg.CopyPicture appearance:=xlScreen, Format:=xlPicture
With New Excel.Application
    With .Workbooks.Add
        With .Worksheets(1).ChartObjects.Add(0, 0, rg.Width, rg.Height).Chart
            ThisWorkbook.Activate
            wsTmp.Select
            wsEnd.Select
            .Paste
            .Export Filename:="C:\Work\最終.jpg", filtername:="jpg"
        End With
        .Close False
    End With
    .Quit
End With
```

ChartObjectsをした後に
そのままだとクリップボードが上手く扱えないのでしょうか・・・
謎ですね。

Answer

> 今週の月曜まではうまく書き出せていたが、
それ以降、内容が反映されていない真っ白な画像が書き出されるようになってしまった。

- 試しに他のファイルでも同様に白紙の画像が保存されますか？されるのであればエクセルファイルに問題がある可能性があります。ファイルを作り直して問題が解決するか試してみてください。

- コードを１行ずつ実行して画像が保存されるか確認しましょう。クリップボードを経由する処理の場合、場合によっては遅延が発生することがありますので、デバッグ実行では上手く行くがコードを通しで実行すると上手く行かない場合はコピーの後に待機処理を入れてみてください。

コードが思った通りに行かない場合はデバッグして問題の切り出しをしてください。コードに変更がなくてもOSのアップデートやOfficeのアップデートにより不具合が発生してしまう可能性もあります。最近何かしら変化点がなかったか確認されるのも良いかと思います。

---
【追記】
当方の環境ではチャート追加の後に待機処理を入れたところjpg画像の保存に成功しました。試していただければと思います。

Answer

エクセルのマクロはわからなくなったら「マクロの記録」で処理をキャプチャーしてやり記録の終了まで一連の処理をマクロとして登録できるので、あとは記録したソースを手で修正すればよいでしょう

投稿2025/12/12 07:33

yambejp

総合スコア118276