升级到Office 2016后打印PDF时出现错误1004

时间:2017-08-18 13:46:39

标签: excel-vba pdf excel-2016 vba excel

我有一个约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,所有其他都丢失。

enter image description here

有人知道如何解决这个错误或者它是怎么回事?

0 个答案:

没有答案