打印后循环冻结 Excel

Question

我有一个创建 CSV 文件并将 CSV 文件存放在原始文件旁边的文件夹中的电子表格。电子表格似乎工作正常。输入数据后，单击导出，CSV 文件将放入原始文件旁边名为 "Uploads" 的文件夹中。

问题出在我使用 Excel 快速访问工具栏上的快速打印按钮时。当我单击快速打印按钮时，一切似乎都可以正常打印。但是，一旦我关闭文件，（编辑：所有打印似乎都在冻结文件。文件一关闭）Excel 然后进入冻结状态，看起来它正在尝试运行一些代码？我是 VBA 的新手，所以我不确定发生了什么，我所知道的是在我的文件关闭后，Excel 冻结，我必须重新启动 Excel。我什至没有任何宏或 VBA 用于 Excel 关闭或 Excel 打开触发器。

任何人都可以重现这个问题并让我深入了解我的代码是如何做到这一点的吗？

Private Sub Export_Click()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim MyPath As String
    Dim MyFileName As String
    'The path and file names:
    MyPath = ActiveWorkbook.Path & "\Uploads"
    MyFileName = "" & Range("a2") & "_Upload"

    On Error GoTo Ending

    'Makes sure the path name ends with "\":
    If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
    'Makes sure the filename ends with ".csv"
    If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
    'Copies the sheet to a new workbook:
    Sheets("UploadData").Copy
    'The new workbook becomes Activeworkbook:
    With ActiveWorkbook 'Saves the new workbook to given folder / filename:
        .SaveAs FileName:= _
                MyPath & MyFileName, _
                FileFormat:=xlCSV, _
                CreateBackup:=False 'Closes the file
        .Close False
    End With

    ChDir MyPath
    Workbooks.Open FileName:= _
                   MyPath & "\" & MyFileName & """"

    ActiveWorkbook.Save
    ActiveWorkbook.Close

    GoTo Skip

Ending:
    MsgBox ("ERROR! Please make sure you have a folder named Uploads next to the template file")
    ActiveWorkbook.Close

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

Skip:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Answer 1

这实际上根本不应该起作用，无论您在运行它之前做了什么。首先，确保 MyPath 以 \ 结尾...

'Makes sure the path name ends with "\":
If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"

...但是当您（重新）构建下面的相同路径时，您将插入第二个 \:

Workbooks.Open FileName:= _
               MyPath & "\" & MyFileName & """"

这个应该总是失败。您可以使用 Scripting.FileSystemObject 的 .BuildPath 函数来避免整个路径问题：

'Requires a reference to Microsoft Scripting Runtime.
Dim filePath As String, fso As New Scripting.FileSystemObject
filePath = fso.BuildPath(ThisWorkbook.Path, MyFileName)

您也可以将其用作文件扩展名：

If LCase$(fso.GetExtensionName(MyFileName)) <> "csv" Then
    MyFileName = MyFileName & ".csv"
End If

请注意，此测试永远不会为真...

If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"

...因为 MyFileName 将总是以 "load":

结尾

MyFileName = "" & Range("a2") & "_Upload"

此外，您应该删除所有对 ActiveWorkbook 的引用。我不知道为什么打印会影响这一点，但我无法确定其他任何问题。我会更像这样构建它（为清楚起见删除了错误处理程序 - 在完成调试之前不要将其放回原处）：

'Add a reference to Microsoft Scripting Runtime.
Private Sub Export_Click()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    With New Scripting.FileSystemObject
        Dim filePath As String
        Dim targetDir As String
        targetDir = .BuildPath(ThisWorkbook.Path, "Uploads")
        If Not .FolderExists(targetDir) Then
            MsgBox ("ERROR! Please make sure you have a folder named Uploads next to the template file")
            Exit Sub
        End If
        filePath = .BuildPath(targetDir, ActiveSheet.Range("A2").Value & "_Upload.csv")
    End With
    'Copies the sheet to a new workbook:
    Dim csv As Workbook
    Set csv = Application.Workbooks.Add
    With csv
        ThisWorkbook.Sheets("UploadData").Copy .Sheets(1)
        .SaveAs Filename:=filePath, _
                FileFormat:=xlCSV, _
                CreateBackup:=False 'Closes the file
        .Close xlDoNotSaveChanges
    End With

    'Reopen and re-save to fix formatting.
    Set csv = Workbooks.Open(filePath)
    csv.Close xlSaveChanges

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

打印后循环冻结 Excel

Loop Freezing Excel After Printing

csv

printing

excel

vba

export-to-csv