我有一个约50个工作表的工作簿。代码循环遍历每张工作表,在每张工作表上分配标题行,打印区域和分页符,然后将PDF打印到特定文件夹。代码工作正常,直到上周,我将Office更新到2016年(来自Excel 2013)。
在成功打印约25张PDF后,我在每张纸上重复出现部分代码错误(默认情况下在同一张纸上,但是当我禁止打印此纸张的部分代码时,我收到错误下一张)。标有**。
的行中出现错误消息 Sub UpdatePDFs_Click()
'some code which saves workbook to server location three times
(first is copy of initial one, second is later opened & changed,
and third one is for running code (deleted at the end))
'code which opens second workbook (PDFbook) and make adjustments
(copying some sheets and deleting some content)
'code which follows:
PDFbook.Save
PDFbook.Close True
Set PDFbook = Application.Workbooks.Open(Def_path & Dir_name & "\" & Filename2)
Dim sht01 As Worksheet
For Each sht01 In PDFbook.Worksheets
If sht01.Name = "sheet1" Then
sht01.Activate
' rows count & HPagebreaks
FinalRow = Cells(Rows.Count, "D").End(xlDown).Row ' number of rows to print
PrintAreaAndHPageBreaks FinalRow ' subroutine which is repeated
' PDF print
ActiveSheet.Range("A1:D" & FinalRow).ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Path_PDF & "SO-" & ActiveSheet.Range("A2") & "-" & ActiveSheet.Range("B2") & "-sheet1", Quality:=xlQualityMinimal
ActiveWindow.View = xlNormalView
ElseIf sht01.Name = "sheet2" Then
sht01.Activate
'etc for all sheets which we want to print
Else
' sht01.Delete
End If
Next sht01
PDFbook.Close True
' close dummy
MsgBox "PDFs were created sucessfully"
Application.DisplayAlerts = False
Dim strFile As String
strFile = ActiveWorkbook.FullName
ActiveWorkbook.Saved = True
Application.ActiveWorkbook.ChangeFileAccess xlReadOnly
Kill strFile
Application.ActiveWorkbook.Close True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub PrintAreaAndHPageBreaks(FinalRow As Long)
' define print area
ActiveSheet.PageSetup.PrintArea = ""
ActiveSheet.ResetAllPageBreaks
With ActiveSheet
.PageSetup.PrintTitleRows = ActiveSheet.Rows(7).Address
.PageSetup.PrintArea = "A1:D" & FinalRow
.VPageBreaks.Add before:=Columns("D")
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = False
End With
Dim NumHPB As Long
Dim Rng As Range
ActiveWindow.View = xlPageBreakPreview
NumHPB = ActiveSheet.HPageBreaks.Count
For j = 1 To NumHPB
Set Rng = ActiveSheet.Range("A" &
ActiveSheet.HPageBreaks.Item(j).Location.Row)
If Rng.Value = "" Then
For i = 1 To 200
**If Rng.Offset(-(i), 0).Interior.ColorIndex = 4 Then**
ActiveSheet.HPageBreaks.Add before:=Rows(ActiveSheet.HPageBreaks.Item(j).Location.Row - i)
Exit For
End If
Next i
End If
Next j
End Sub
我收到错误1004,有时Excel会自行重启或freezes。指定文件夹中的结果是相同的:〜25个PDF成功打印(到第二个Sub出现错误的循环),然后大约10个PDF大小为5Kb,所有其他都丢失。
有人知道如何解决这个错误或者它是怎么回事?