Зацикливание «пакетного экспорта» сбоев - ошибка процессора или кода? - PullRequest
Новая
       5

Зацикливание «пакетного экспорта» сбоев - ошибка процессора или кода?

0 голосов
/ 31 мая 2018

Почему Excel не может перебирать большие наборы данных?!

У меня есть 2 разные формы документов, которые нужно экспортировать в PDF сотнями.Я извлек сценарий пакетного экспорта из Интернета и изменил его для своего использования, чтобы он обрабатывал любую из этих форм в зависимости от флажка, установленного на листе «Пакетный принтер PDF».

Все работает хорошо - для первых 10-15 рабочих книг, к которым обращается цикл, а затем происходит сбой.Каждый документ Excel зависает (не отвечает), и страница, к которой в данный момент обращается макрос, частично открывается без видимых данных или ячеек.В этом случае окно сообщения «Публикация» также может зависнуть.Однажды сообщалось об ошибке памяти - но я не смог повторить это.Разве Excel не должен удалять неиспользуемый кеш, чтобы не перегружать память?Я бы заподозрил петлю задницы, если она какое-то время не работает.Я слышал, что нет никакого способа написать сценарий в «дампе кэша» или что-то в этом роде.Это плохой код или я слишком много прошу моего процессора? 

Sub Convert2PDF()
'Update the checkbox linked formulas on the GUI workbook
Sheet1.Range("A2").Formula = Sheet1.Range("A2").Formula
Sheet1.Range("B2").Formula = Sheet1.Range("B2").Formula
Sheet1.Range("C2").Formula = Sheet1.Range("C2").Formula

Dim strFolder As String
Dim strXLFile As String
Dim strPDFFile As String
Dim wbk As Workbook
Dim lngPos As Long
' set folder
strFolder = ThisWorkbook.Path & "\putfileshere" & "\"
Application.ScreenUpdating = False
' Get first filename
strXLFile = Dir(strFolder & "*.xls*")
' Loop through Excel workbooks in folder
Do While strXLFile <> ""
    ' Open workbook
    Set wbk = Workbooks.Open(Filename:=strFolder & strXLFile)
    ' Assemble the PDF filename
    lngPos = InStrRev(strXLFile, ".")
    strPDFFile = Left(strXLFile, lngPos) & "pdf"
    ' Export to PDF
    'Do the next 8 lines crash the Macro because they recalculate for every sheet? Page1, Page2, Page3 value are the same for all workbooks processed in a batch
            Dim Page1 As String
            Dim Page2 As String
            Dim Page3 As String
            Dim Page4 As String
                Page1 = ThisWorkbook.Sheets("Batch PDF Printer").Range("A2")
                Page2 = ThisWorkbook.Sheets("Batch PDF Printer").Range("B2")
                Page3 = ThisWorkbook.Sheets("Batch PDF Printer").Range("C2")

            If ThisWorkbook.Sheets("Batch PDF Printer").Range("C2") = "" Then 
                wbk.Sheets(Array(Page1, Page2)).Select
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                    ThisWorkbook.Path & "\pdfsgohere" & "\" & wbk.Name, _
                    Quality:=xlQualityStandard, IncludeDocProperties:=False, _
                    IgnorePrintAreas:=False, OpenAfterPublish:=False

'run process for format option 2
            Else:
                wbk.Sheets(Array(Page1, Page2, Page3)).Select
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                    ThisWorkbook.Path & "\pdfsgohere" & "\" & wbk.Name, _
                    Quality:=xlQualityStandard, IncludeDocProperties:=False, _
                    IgnorePrintAreas:=False, OpenAfterPublish:=False
            'Tried killing the finished document to improve function
                Dim xFullName As String
                xFullName = Application.ActiveWorkbook.FullName
                ActiveWorkbook.Saved = True
                Application.ActiveWorkbook.ChangeFileAccess xlReadOnly
                Kill xFullName
                Application.ActiveWorkbook.Close False

            End If
    ' Close workbook - didn't seem to help (can't do it when the workbook is gone)
       'wbk.Close SaveChanges:=False

    ' Get next filename
    strXLFile = Dir
Loop
Application.ScreenUpdating = True
MsgBox "All Done"

Спасибо за помощь.Я пытался понять это уже несколько дней.

Ответы [ 2 ]

0 голосов
/ 03 июня 2018

Даже если ваша видимая системная память не перегружена, внутренняя емкость приложения Excel на короткое время кажется превышенной.Мне удалось наконец просмотреть окно сообщения «Недостаточно системных ресурсов для отображения полностью», прежде чем приложение перешло в автоматическую перезагрузку.Попробуйте упростить рабочие книги, к которым обращается цикл.Если для запуска рабочих книг требуется некоторое время, это может свидетельствовать о тяжелых фоновых процессах (вычисления и подпрограммы VBA).DoEvents может помочь коду работать более плавно, запрашивая больше времени на обработку, чтобы система могла отсортировать его требования.В конечном итоге,

Application.Calculation = xlManual

в верхней части цикла было достаточно, чтобы уменьшить вычислительные требования к системе на 20 гигов (которую я никогда не ожидал перегрузить).

0 голосов
/ 01 июня 2018

Для меня это> 30 файлов без проблем: 

Sub Convert2PDF()

    Dim strFolder As String, strXLFile As String
    Dim strPDFFile As String
    Dim wbk As Workbook
    Dim lngPos As Long
    Dim pages(1 To 4) As String
    Dim shtBatch As Worksheet, arr

    Set shtBatch = ThisWorkbook.Sheets("Batch PDF Printer")
    shtBatch.Range("A2:C2").Calculate '<< assume this was the point of resetting the formulas?
    pages(1) = shtBatch.Range("A2").Value
    pages(2) = shtBatch.Range("B2").Value
    pages(3) = shtBatch.Range("C2").Value

    'what pages to print?  Only need to do this once
    arr = IIf(Len(pages(3)) = 0, Array(pages(1), pages(2)), _
                                 Array(pages(1), pages(2), pages(3)))

    strFolder = ThisWorkbook.Path & "\putfileshere\"
    strXLFile = Dir(strFolder & "*.xls*")

    Do While strXLFile <> ""

        Set wbk = Workbooks.Open(Filename:=strFolder & strXLFile, ReadOnly:=True)

        lngPos = InStrRev(strXLFile, ".")
        strPDFFile = Left(strXLFile, lngPos) & "pdf"

        wbk.Sheets(arr).Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=ThisWorkbook.Path & "\pdfsgohere\" & strPDFFile, _
            Quality:=xlQualityStandard, IncludeDocProperties:=False, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False

        wbk.Close False

        strXLFile = Dir
    Loop

    MsgBox "All Done"

End Sub
...