Excel Macro VBA - ошибка при экспорте всех диаграмм в один PDF - PullRequest
0 голосов
/ 30 января 2020

У меня есть следующий код, чтобы скопировать все диаграммы из электронной таблицы Excel в новую электронную таблицу, а затем распечатать их все в одном документе PDF.

Время от времени макрос завершается сбоем, и нам нужно восстановить файл, чтобы он снова заработал, но мы никогда не меняем электронную таблицу или код.

Вот код:

Sub AllChartsInWorkbookToPDF()
'--makes a separte pdf file with one chart per sheet
'     for each sheet in ActiveWorkbook with any embedded charts

    Dim ws As Worksheet

    Application.ScreenUpdating = False
    For Each ws In Worksheets
        If ws.ChartObjects.Count > 0 Then _
            Call MakePDFBookFromWorksheet(ws)
    Next ws
    Application.ScreenUpdating = True
    MsgBox "Done"
End Sub

Private Function MakePDFBookFromWorksheet(ws As Worksheet)
'---make a pdf file of all charts in worksheet ws
'      with one chart per sheet

    Dim cht As ChartObject
    Dim wsTemp As Worksheet
    Dim sChartRange As String

    '--create new temporary workbook
    ws.Copy
    '--wsTemp will have the embedded charts to be processed
    Set wsTemp = ActiveSheet

    For Each cht In wsTemp.ChartObjects
        '--copy each chartObject a new sheet
        Sheets.Add After:=Sheets(Sheets.Count)
        With cht.Chart.ChartArea
            .Copy
            ActiveSheet.Paste
            '--set print area to range of chart
            With ActiveSheet.ChartObjects(1)
                .Top = 0
                .Left = 0
                sChartRange = Range(.TopLeftCell, _
                    .BottomRightCell).Address
            End With

            Application.PrintCommunication = False
            With ActiveSheet.PageSetup
                .PrintArea = sChartRange
            End With
            Application.PrintCommunication = True

            Range("A1").Select 'deselect chart
        End With
    Next cht
    '--delete temp sheet
    Application.DisplayAlerts = False
    wsTemp.Delete
    Application.DisplayAlerts = True

    '--modify page setup for all sheets
    Call SetupPages

    '--export temp workbook as PDF
    ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=ws.Parent.Path & "\" & ws.Name & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False

    '--close temp workbook
    ActiveWorkbook.Close SaveChanges:=False
End Function

Private Function SetupPages()
    '--modify page setup for all sheets
    Dim i As Long
    Dim sSheetnames() As String

    With ActiveWorkbook.Sheets
        ReDim sSheetnames(1 To .Count)
        For i = 1 To .Count
            sSheetnames(i) = .Item(i).Name
        Next i
    End With

    Sheets(sSheetnames).Select
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        '--modify these for your desired setup
        .LeftMargin = 18 ' 36 points = 0.5 inches
        .RightMargin = 18
        .TopMargin = 18
        .BottomMargin = 18
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
        .PaperSize = xlPaperA4
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    Application.PrintCommunication = True
End Function

Ошибка, которую мы иногда получаем:

Ошибка во время выполнения '1004': сбой метода вставки класса Worksheet

В параметре Debug происходит сбой на ActiveSheet.Paste line.

Может кто-нибудь объяснить, почему это происходит и как я могу остановить это?

Спасибо

Мэтт

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...