Ошибка выполнения 1004 Ошибка вставки метода класса листа

У меня есть следующая подпрограмма. Я новичок в VBA, поэтому я считаю, что это неэффективно и неуклюже. По сути, я пытаюсь вызвать другую подпрограмму (UpdateBlocksSingle), которая что-то делает, и затем я хотел бы сделать снимок экрана с результатами, вставить его в новую электронную таблицу под названием «Скриншоты», а затем экспортировать результаты в PDF-файл. Все это делается в цикле, поэтому я генерирую много скриншотов (и много страниц в формате pdf). Я также начинаю процесс снятия скриншота из цикла.

Часть, которая продолжает генерировать ошибку 1004:

CopyRangeSingle.CopyPicture xlScreen, xlPicture
Screen.Paste Destination:=PasteRange.Offset(56 * i, 1)
Sheets("Screenshots").Rows(56 * i).PageBreak = xlPageBreakManual

Ошибка будет возникать случайным образом, то есть иногда после 10 итераций в цикле, а иногда после 1 или 2. Когда я меняю тип внешнего вида с xlScreen на xlPrinter, я больше не получаю ошибку. Буду очень благодарен совету Энди о том, как изменить код, чтобы я мог успешно проходить и делать скриншоты при сохранении разрешения xlScreen.

Sub LoopWaterProviders()

'If a former Screenshot tab exits delete it
Dim ws As Worksheet

For Each ws In Worksheets
    If ws.Name = "Screenshots" Then
        Application.DisplayAlerts = False
        Sheets("Screenshots").Delete
        Application.DisplayAlerts = True
    End If
Next

Call CreateSheet

Sheets("BlockChart").Select

Dim WaterProviders As Long
Dim OpenPDF As Boolean
Dim ProviderType As Long
Dim j As Long
Dim i As Long
Dim OutSht As Worksheet
Dim CopyRangeSingle As Range
Dim CopyRangeBlock As Range
Dim PasteRange As Range
Dim Block As Worksheet
Dim Screen As Worksheet

j = 1
ProviderType = Sheets("Multiple Block Charts").Range("A1").Value
OpenPDF = Sheets("Multiple Block Charts").Range("A2").Value
Set Screen = Sheets("Screenshots")
Set Block = Sheets("BlockChart")
Set CopyRangeSingle = Block.Range("S1:AJ50")
Set CopyRangeBlock = Block.Range("A1:P43")
Set PasteRange = Screen.Cells(1, 1)

If ProviderType = 1 Then
WaterProviders = Sheets("Calculations_Single").Range("C11").Value
ElseIf ProviderType = 2 Then
WaterProviders = Sheets("Multiple Block Charts").Range("F13").Value
ElseIf ProviderType = 3 Then
WaterProviders = Sheets("Multiple Block Charts").Range("H15").Value
ElseIf ProviderType = 4 Then
WaterProviders = Sheets("Multiple Block Charts").Range("K61").Value
Else: WaterProviders = Sheets("Calculations_Single").Range("C11").Value
End If

Application.DisplayStatusBar = True
CopyRangeBlock.CopyPicture xlPrinter, xlPicture
Screen.Paste Destination:=PasteRange
Sheets("Screenshots").Rows(56).PageBreak = xlPageBreakManual
Application.CutCopyMode = False


Worksheets("BlockChart").Select

For i = 1 To WaterProviders

    If ProviderType = 1 Then
    Sheets("Calculations_Single").Range("C12").Value = i
    ElseIf ProviderType = 2 Then
    Sheets("Calculations_Single").Range("C12").Value = Sheets("Multiple Block Charts").Cells(i + 1, 6)
    ElseIf ProviderType = 3 Then
    Sheets("Calculations_Single").Range("C12").Value = Sheets("Multiple Block Charts").Cells(i + 1, 9)
    ElseIf ProviderType = 4 Then
    Sheets("Calculations_Single").Range("C12").Value = Sheets("Multiple Block Charts").Cells(i + 1, 12)

    Else: Sheets("Calculations_Single").Range("C12").Value = i
    End If

    Call UpdateBlocksSingle

    CopyRangeSingle.CopyPicture xlScreen, xlPicture
    Screen.Paste Destination:=PasteRange.Offset(56 * i, 1)
    Sheets("Screenshots").Rows(56 * i).PageBreak = xlPageBreakManual

    Next i

    Sheets("Screenshots").Range("A:S").ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:="G:\P_and_R\DATA_TOOLS\Shortage Impacts\Single_Year_BLOCK_CHART\Provider_and_CAP_Supply_Block_AC_ver1.X_Output\ProviderOutputCharts", _
    OpenAfterPublish:=OpenPDF, _
    Quality:=xlQualityHighest, _
    From:=1, _
    To:=WaterProviders + 1


MsgBox "Export complete and PDF saved to 'G:\P_and_R\DATA_TOOLS\Shortage Impacts\Single_Year_BLOCK_CHART\Provider_and_CAP_Supply_Block_AC_ver1.X_Output' "
Sheets("BlockChart").Select

End Sub
0