[[20230609162833]]　『ごくまれに「実行時エラー1004」か「rngクラスのc』（appletea）　ページの最後に飛ぶ

『ごくまれに「実行時エラー1004」か「rngクラスのcopypictureメソッドが失敗。」というエラーが出るのを何とかしたい。』（appletea）

現在vbaのコードを１時間に１回のペースで自動で回しています。

何回に1回という細かいところまではわかりませんが稀に以下のエラーが出ます。

・実行時エラー1004

・rngクラスのcopypictureメソッドが失敗。

できれば自分はかかわらず全自動でずっと回したいと思っています。

どなたか対処法を教えていただけますか。

vbaコード

Private Sub Workbook_Open()

    Dim FileSize As Long
    Dim pic As ChartObject
    Dim picNameArray As Variant
    picNameArray = Array("\1.png", "\2.png", "\3.png", "\4.png", "\5.png")
    Dim rngArray As Variant
    rngArray = Array(Range("A1:H18"), Range("J2:P13"), Range("R2:X13"), Range("J15:P26"), Range("R15:X26"))

    Dim saveFolderPath As String
    saveFolderPath = "自分のフォルダ"

    For i = 0 To 4 ' 5回繰り返す
        Dim rng As Range: Set rng = rngArray(i)
        Dim picName As String: picName = picNameArray(i)

        '■セル範囲を画像データでコピーする。
        rng.Select
        rng.CopyPicture

        '■指定したセル範囲と同じサイズのpicを新規作成し、保存する。
        Set pic = ActiveSheet.ChartObjects.Add(0, 0, rng.Width, rng.Height)
        pic.Chart.Export saveFolderPath & picName
        FileSize = FileLen(saveFolderPath & picName)

        '■picのFileSizeを超えるまでループする(画像データが出来上がったら終了する)
        Do Until FileLen(saveFolderPath & picName) > FileSize
            pic.Chart.Paste
            pic.Chart.Export saveFolderPath & picName
            DoEvents
        Loop

        '■作成完了後、pic削除。
        pic.Delete
        Set pic = Nothing
    Next i

        '■上書き保存
        ThisWorkbook.Save
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
        Application.Quit
    End Sub

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

 CopyPictureで失敗ってことは「クリップボードと通信出来ませんでした」ってことになろうかと思うので、
 対症療法的には「DoEventsして再チャレンジ」みたいな策を試してみたりとか...

    Private Declare PtrSafe Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds As Long)

        '■セル範囲を画像データでコピーする。
        rng.Select
        Do
            Dim nErr As Long, errCount As Long
            DoEvents
            Sleep 50
            On Error Resume Next
            rng.CopyPicture
            nErr = Err.Number
            On Error GoTo 0
            If nErr = 0 Then Exit Do
            errCount = errCount + 1
        Loop Until errCount > 10 'リトライ回数の上限

（白茶） 2023/06/09(金) 18:22:21

連絡遅くなりました。
その方法で試してみます。
（appletea） 2023/06/12(月) 10:01:49

エラーは出なくなりましたありがとうございます。
ですが違う問題が出てきたので別でまた質問しています。
（appletea） 2023/06/12(月) 10:19:34

＞別でまた質問しています。
[[20230612100203]]
のようです。
（IT） 2023/06/12(月) 10:55:17

コメント返信：

[ 一覧(最新更新順) ]

[[20230609162833]] 『ごくまれに「実行時エラー1004」か「rngクラスのc』（appletea） ページの最後に飛ぶ

[[20230609162833]]　『ごくまれに「実行時エラー1004」か「rngクラスのc』（appletea）　ページの最後に飛ぶ