Question

让SaveAs命令正常工作我遇到了很多困难。对于本地医院，存在从模板文件创建的患者图表，其中输入患者数据，之后手动重命名（使用另存为），然后将其作为备份复制到另一个位置。模板一遍又一遍地重复使用。

我的代码的目标是自动执行此过程。因此，我想从模板文件开始保存到两个不同的位置。不应覆盖模板文件。在模板中，用户分别在单元格K1和N1中设置部门名称和床号。这些字段确定该文件夹中的文件夹和文件名。

按下保存按钮后，我的代码开始运行。我使用SaveCopyAs保存备份文件，之后我想使用SaveAs保存到我的主文件夹。 SaveAs应该将此新文件设置为我的工作文件，因此不会覆盖我的模板。至少这是我所相信的......

问题：运行SaveAs时，Excel崩溃（没有任何明确的错误消息）。奇怪的是（对我而言）当我用SaveAs替换SaveCopyAs时不会崩溃。

问题：为什么Excel会在此时崩溃？有没有办法解决或避免这种行为？我找不到合适的解决方案，不会改变我的模板。任何帮助或建议都非常受欢迎。

下面的代码放在我的“ThisWorkbook”文件夹中，每次单击“保存”按钮时都会执行。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    department = Range("K1").Value 'Name of department: CHIC, THIC, ICB or NCIC
    bedNumber = Range("N1").Value 'bednumber or roomnumber: Bed 1. Bed 2 or Room 1, Room 2.
    newFileName = department & "\" & bedNumber & ".xls"

    If IsEmpty(department) Then
        MsgBox "You haven't entered a department. Please try again."
    ElseIf IsEmpty(bedNumber) Then
        MsgBox "You haven't entered a bed or room number. Please try again."
    Else
        ActiveWorkbook.SaveCopyAs "C:\myBackupFolder\" + newFileName
    End If


    ActiveWorkbook.SaveAs "C:\myPrimaryFolder\" + newFileName 'Doesn't work

    'ActiveWorkbook.SaveCopyAs "C:\myPrimaryFolder\" + newFileName 'Does work, but I end up with a messed up template!
End Sub

Answer 1

除了设置Cancel = True以防止默认保存行为外，还要添加：

Application.EnableEvents = False
ActiveWorkbook.SaveAs "C:\myPrimaryFolder\" + newFileName 'Doesn't work
Application.EnableEvents = True

防止再次调用相同的过程（并再次调用..）。这可能就是崩溃的原因。

SaveAs命令不起作用，但SaveCopyAs不起作用

1 个答案: