Ошибка компиляции VBA: синтаксическая ошибка для сохранения Excel в PDF для Excel 2019 - PullRequest
Новая
       44

Ошибка компиляции VBA: синтаксическая ошибка для сохранения Excel в PDF для Excel 2019

0 голосов
/ 20 февраля 2020

Я получаю «Ошибка компиляции: ошибка синтаксиса» при выполнении кода ниже с использованием Excel 2019. Он работает с более старой версией Excel, но не с 2019. Как я могу это исправить и что это вызывает?

строка ошибки 

ReportSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

        ThisWorkbook.Path & "\" & Cell, _

        Quality:=xlQualityStandard, IncludeDocProperties:=True, _

        IgnorePrintAreas:=True, OpenAfterPublish:=False

Весь код 

Option Explicit

Private Sub CommandButton1_Click()



Dim MyFolder As String, MyFile As String

Dim StartTime As Double

Dim MinutesElapsed As String

Dim Filename As String

Dim Cell As String

Dim Counter As Long



            If ThisWorkbook.Sheets("Sheet1").Range("C7").Value = vbNullString Then

            MsgBox "Enter Tab Name"

            Exit Sub



            End If


StartTime = Timer



            With Application.FileDialog(msoFileDialogFolderPicker)

               .AllowMultiSelect = False

               .Title = "Select a Folder"

               If .Show = True Then

               MyFolder = .SelectedItems(1)

               End If



               If .SelectedItems.Count = 0 Then Exit Sub

               Err.Clear

            End With


            'Turns settings off
            Application.ScreenUpdating = False

            Application.DisplayStatusBar = False

            Application.EnableEvents = False

            Application.Calculation = xlCalculationManual


            MyFile = Dir(MyFolder & "\", vbReadOnly)


Do While MyFile <> ""

        DoEvents

        On Error GoTo 0

        Workbooks.Open Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False


Dim ReportSheet As Worksheet

Dim MySheet As String

Dim allColumns As Range



MySheet = ThisWorkbook.Sheets("Sheet1").Range("C7").Value



Set ReportSheet = Sheets(MySheet)

Set allColumns = ReportSheet.Columns("N:S")

        allColumns.Hidden = True



        With ReportSheet.PageSetup

         .Zoom = False

         .FitToPagesWide = 1    '.FitToPagesTall = 1

        End With


Filename = ActiveWorkbook.Name



Cell = Replace(Filename, ".xlsx", ".PDF")   

    ReportSheet.Select



    ReportSheet.PageSetup.Orientation = xlLandscape


    ReportSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

        ThisWorkbook.Path & "\" & Cell, _

        Quality:=xlQualityStandard, IncludeDocProperties:=True, _

        IgnorePrintAreas:=True, OpenAfterPublish:=False



Counter = Counter + 1

0

        Workbooks(MyFile).Close SaveChanges:=False

        MyFile = Dir

Loop


    'turns settings back on that you turned off before looping folders



        Application.ScreenUpdating = True

        Application.DisplayStatusBar = True

        Application.EnableEvents = True

        Application.Calculation = xlCalculationManual


MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")

MsgBox "Successfully Converted " & Counter & " Files in " & MinutesElapsed & " minutes", vbInformation



End Sub

1 Ответ

1 голос
/ 20 февраля 2020

Оставляя пустую строку при использовании продолжения строки * Символ 1001 * недопустим в любой версии Excel (AFAIK)

Код, вызывающий проблемы, должен быть: 

ReportSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & Cell, _
                                Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                                IgnorePrintAreas:=True, OpenAfterPublish:=False

Попробуйте сделать отступ в своем коде правильно и удалите лишние строки.

Код: 

Option Explicit

Private Sub CommandButton1_Click()



    Dim MyFolder As String, MyFile As String

    Dim StartTime As Double

    Dim MinutesElapsed As String

    Dim Filename As String

    Dim Cell As String

    Dim Counter As Long



    If ThisWorkbook.Sheets("Sheet1").Range("C7").Value = vbNullString Then

        MsgBox "Enter Tab Name"

        Exit Sub



    End If


    StartTime = Timer



    With Application.FileDialog(msoFileDialogFolderPicker)

        .AllowMultiSelect = False

        .Title = "Select a Folder"

        If .Show = True Then

            MyFolder = .SelectedItems(1)

        End If



        If .SelectedItems.Count = 0 Then Exit Sub

        Err.Clear

    End With


    'Turns settings off
    Application.ScreenUpdating = False

    Application.DisplayStatusBar = False

    Application.EnableEvents = False

    Application.Calculation = xlCalculationManual


    MyFile = Dir(MyFolder & "\", vbReadOnly)


    Do While MyFile <> ""

        DoEvents

        On Error GoTo 0

        Workbooks.Open Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False


        Dim ReportSheet As Worksheet

        Dim MySheet As String

        Dim allColumns As Range



        MySheet = ThisWorkbook.Sheets("Sheet1").Range("C7").Value



        Set ReportSheet = Sheets(MySheet)

        Set allColumns = ReportSheet.Columns("N:S")

        allColumns.Hidden = True



        With ReportSheet.PageSetup

            .Zoom = False

            .FitToPagesWide = 1                  '.FitToPagesTall = 1

        End With


        Filename = ActiveWorkbook.Name



        Cell = Replace(Filename, ".xlsx", ".PDF")

        ReportSheet.Select



        ReportSheet.PageSetup.Orientation = xlLandscape


        ReportSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & Cell, _
                                        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                                        IgnorePrintAreas:=True, OpenAfterPublish:=False



        Counter = Counter + 1



        Workbooks(MyFile).Close SaveChanges:=False

        MyFile = Dir

    Loop


    'turns settings back on that you turned off before looping folders



    Application.ScreenUpdating = True

    Application.DisplayStatusBar = True

    Application.EnableEvents = True

    Application.Calculation = xlCalculationManual


    MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")

    MsgBox "Successfully Converted " & Counter & " Files in " & MinutesElapsed & " minutes", vbInformation



End Sub

Примечание: не просматривал другие части кода

...