Печать файлов Excel, соответствующих ячейке, но первый файл не печатается - PullRequest
0 голосов
/ 07 марта 2019

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

По какой-то причине цикл не печатает первый файл в списке. Когда я прохожу, они все печатают.

Кто-нибудь видит в моем коде что-нибудь, что может решить эту проблему?

Спасибо

РЕДАКТИРОВАТЬ: проблема заключалась в том, что включение PrintCommunication приводило к сбою первого листа. PrintCommunication необходим, поэтому PageSetup работает как нужно.

Код обновлен ниже для всех, чтобы использовать. Все, что вам нужно изменить, это местоположение MyFolder или использовать With Application.FileDialog(msoFileDialogFolderPicker), чтобы выбрать папку.

Sub ExcelPrint()
Application.DisplayAlerts = False
Dim OpenFile As Variant
Dim MyFile As String, MyFolder As String, AorB As String
Dim sourceFolder As String, destFolder As String
Dim LR As Long

MyFolder = ThisWorkbook.ActiveSheet.Range("B1").Value
LR = Cells(Rows.Count, "B").End(xlUp).Row
sourceFolder = Environ("Userprofile") & "\Desktop\PDF\"
destFolder = sourceFolder & "_Temp\"

If Len(Dir(sourceFolder, vbDirectory)) = 0 Then
    MkDir sourceFolder
End If

If Len(Dir(destFolder, vbDirectory)) = 0 Then
    MkDir destFolder
End If

On Error GoTo eHandler    
With Worksheets("Print")
For i = 3 To LR
    MyFile = ThisWorkbook.ActiveSheet.Cells(i, 2)
    AorB = Mid(Cells(i, 2), 4, 1)
    OpenFile = MyFolder & MyFile & ".xlsx"
    Application.StatusBar = "Printing " & MyFile & ".xlsx"

    Workbooks.Open _
            FileName:=OpenFile, _
            ReadOnly:=True

    Application.PrintCommunication = False
        With ActiveSheet.PageSetup
            .Orientation = xlLandscape
            .FitToPagesTall = 1
            .FitToPagesWide = 1
            If AorB = "A" Then
                .PaperSize = xlPaperLetter
            ElseIf AorB = "B" Then
                .PaperSize = xlPaperTabloid
            End If
        End With
'This was the problem        
'Application.PrintCommunication = True

    ActiveSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        FileName:=destFolder & MyFile & ".pdf", _
        Quality:=xlQualityStandard, _
        IgnorePrintAreas:=False, _
        From:=1, To:=1, _
        OpenAfterPublish:=True
    ActiveWorkbook.Close
    Application.StatusBar = vbNullString

    'Green Highlight if printed
    With ThisWorkbook.Sheets("Print")
    Application.ScreenUpdating = True
        If Not Dir(destFolder & MyFile & ".pdf", vbDirectory) = vbNullString Then
            Sheets("Print").Cells(i, 2).Interior.ColorIndex = 10
            Sheets("Print").Cells(i, 2).Font.Color = vbWhite
        End If
    Application.ScreenUpdating = False
    End With

nextLine:
Next i
End With
Exit Sub

eHandler:
If err.Number = 1004 Then
    Resume nextLine
ElseIf err.Number = 424 Then
    Resume nextLine
ElseIf err.Number = 9 Then
    Resume nextLine
End If

MsgBox err.Number & vbCrLf & err.Description
Application.StatusBar = vbNullString
Application.DisplayAlerts = True
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...