首页 > 解决方案 > VBA 代码仅在使用断点时完全有效

问题描述

我遇到了以下代码的问题。“现金流”表不会改变高度以适合一页。当我使用断点时,它可以工作,但是在运行宏时似乎跳过了该行。我尝试过使用 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

标签: excelvba

解决方案


推荐阅读