Код VBA полностью работает только при использовании точки останова - PullRequest
0 голосов
/ 10 июля 2020

У меня проблема с приведенным ниже кодом. Лист «Ca sh Flow» не изменит высоту, чтобы поместиться на одной странице. Когда я использую точку останова, она работает, но эта строка кажется пропущенной при запуске макроса. Я пробовал использовать Application.Wait, но это не сработало. Есть мысли о том, как это исправить? Заранее благодарим!

Раздел кода, который не работает:

Sheets("Cash Flow").Select
With ActiveSheet.PageSetup
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1

Полный код:

    Dim wb As Workbook
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String
    Dim FldrPicker As FileDialog

      'Optimize Macro Speed
      Application.ScreenUpdating = False
      Application.EnableEvents = False
      Application.Calculation = xlCalculationManual

      'Retrieve Target Folder Path From User
      Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

    'In Case of Cancel
     NextCode:
     myPath = myPath
     `enter code here` If myPath = "" Then GoTo ResetSettings

      'Target File Extension (must include wildcard "*")
       myExtension = "*.xls*"

      'Target Path with Ending Extention
       myFile = Dir(myPath & myExtension)

      'Loop through each Excel file in folder
       Do While myFile <> ""
       'Set variable equal to opened workbook
        Set wb = Workbooks.Open(Filename:=myPath & myFile)
    
    'Ensure Workbook has opened before moving on to next line of code
      DoEvents
    
    'Sets Page Height ad Width
      
        Dim myArray() As Variant
    Dim i As Integer
    For i = 1 To Sheets.Count
        ReDim Preserve myArray(i - 1)
        myArray(i - 1) = i
    Next i
    Sheets(myArray).Select
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 0
    End With
    Sheets("Cash Flow").Select
    With ActiveSheet.PageSetup
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    
       
    End With
    Dim wsA As Worksheet
    Dim wbA As Workbook
    Dim strName As String
    Dim strPath As String
    Dim strFile As String
    Dim strPathFile As String


    Set wbA = ActiveWorkbook
    Set wsA = ActiveSheet

    'get active workbook folder, if saved
     strPath = wbA.Path
     If strPath = "" Then
      strPath = Application.DefaultFilePath
      End If
      strPath = strPath & "\"

      strName = CreateObject("Scripting.FileSystemObject").GetBaseName(ActiveWorkbook.Name)
         

     'create default name for savng file
    strFile = strName & ".pdf"
    strPathFile = strPath & strFile

      'export to PDF in current folder
      ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=strPathFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    
    'Save and Close Workbook
      wb.Close SaveChanges:=True
      
    'Ensure Workbook has closed before moving on to next line of code
      DoEvents

    'Get next file name
      myFile = Dir
    Loop

     'Message Box when tasks are completed
      MsgBox "Task Complete!"

     ResetSettings:
    'Reset Macro Optimization Settings
     Application.EnableEvents = True
     Application.Calculation = xlCalculationAutomatic
     Application.ScreenUpdating = True

     End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...