У меня есть следующий код, чтобы скопировать все диаграммы из электронной таблицы 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.
Может кто-нибудь объяснить, почему это происходит и как я могу остановить это?
Спасибо
Мэтт