Question

我有一个奇怪的问题。我工作的橱柜业务使用Excel工作簿进行定价。我们在保存在多个工作簿中的部分中对作业进行定价，并且在完成之后我们有一个将价格编译成一个文件的宏。我们所有的文件都存储在通过网络访问的NAS上。

这就是奇怪的地方。有时，在编译价格时，宏将在打开源工作簿时冻结。没有错误，只是卡住了加载。我可以通过遍历代码来判断它是否打开了工作簿，但它会立即卡住。我已经尝试使用和不启用Application.EnableEvents，并且都没有工作。它以只读方式打开，关闭更新链接。

在我们的定价工作表上，我们有2个按钮，一个用于命名和保存文件，另一个用于执行相同操作，另外还可以为工作的下一部分重置工作簿。两个宏的保存部分几乎相同，主要区别在于重置部分。当我第一次使用“保存并重置”按钮，然后重新定位并使用“保存/另存为”按钮时，我描述的问题只发生。第一个工作簿在编译期间工作正常，第二个工作簿冻结它。如果我打开问题工作簿并重新保存它，问题就会消失。我整个早上一直在抨击这个，我还没弄明白发生了什么。任何方向都将非常感谢！

代码

保存/另存为宏

Dim FldrName, ThisFile As String

ThisFile = Sheet3.Range("FileName")
FldrName = Sheet3.Range("FolderName")

Application.DisplayAlerts = False
Application.EnableEvents = False

ThisWorkbook.SaveAs "\\qctnas\Google Drive\Production\" & FldrName & "\" & _
ThisFile & ".xlsm", 52

Application.DisplayAlerts = True
Application.EnableEvents = True

保存并重置宏

Dim FldrName, ThisFile As String
Dim Ans As Integer

'This section is identical to the previous macro

ThisFile = Sheet3.Range("FileName")
FldrName = Sheet3.Range("FolderName")

Application.DisplayAlerts = False
Application.EnableEvents = False

ThisWorkbook.SaveAs "\\qctnas\Google Drive\Production\" & FldrName & "\" & _
ThisFile & ".xlsm", 52

Application.DisplayAlerts = True
Application.EnableEvents = True


Before  'A simple sub which turns off EnableEvents, ScreenUpdating, and DisplayAlerts

ThisWorkbook.SaveAs "\\qctnas\Google Drive\Production\- IP Proposal\QCT Proposal" & _ 
".xlsm", 52  'Saves as a copy to keep the original from being changed

'This portion resets the values on the workbook

Ans = MsgBox("Reset Specs?", vbYesNo + vbQuestion)

If Ans = 6 Then
    With Sheet3
        .Range("ChangeToNA").Value = "Not applicable"
        .Range("ChangeToChooseFinish").Value = "CHOOSE FINISH"
        .Range("ChangeToYes").Value = "Yes"
        .Range("ChangeToNo").Value = "No"
        .Range("ChangeToStandard").Value = "Standard"
        .Range("JIEmptyThese").Value = ""
        .Range("CMAP").Value = 50
    End With
Else
    Sheet3.Range("JIEmptyWhenNotReset").Value = ""
End If

With Sheet11
    .Range("DCEmptyThese").Value = ""
    .Range("ChangeTo1").Value = "1"
    .Range("ChangeTo4").Value = "4"""
    .Range("MiscCrown").Value = "(Misc. Crown)"
    .Range("MiscMolding").Value = "(Misc. Molding)"
    .Range("ChangeToShipV").Value = "(Ship/V)"
    .Range("ChangeTo8Dollars").Value = 8
End With

With Sheet2
    .Range("IEmptyThese").Value = ""
    .Range("DeleteValidationInThese").Validation.Delete
End With

Sheet2.Unprotect
Application.Goto Sheet2.Range("a68"), True
Sheet2.Range("b82").Select

Application.Goto Sheet11.Range("a1"), True
Sheet11.Range("b4").Select

Sheet3.Unprotect
Application.Goto Sheet3.Range("DelDrop").Offset(-1, -2), True
Sheet3.Range("DelDrop").Select

After  'Mirrors the Before sub

编译宏

Dim IWB As Workbook
Dim IWBJ, IWBI As Worksheet
Dim FldrName, JobFldr, FileName As String

Before

JobFldr = Sheet1.Range("FolderName")
FldrName = "\\qctnas\Google Drive\Production\" & JobFldr & "\"

FileName = Dir(FldrName & "*QCT Proposal*.xlsm")

Do While FileName <> ""
    Set IWB = Workbooks.Open(FldrName & FileName, False, True)
    Set IWBI = IWB.Sheets("Invoice")
    Set IWBJ = IWB.Sheets("Job Info")

    'Copy info

    FileName = Dir()
Loop

After

Answer 1

清理以下代码修复了问题。不知道为什么。

更改了此内容：

On Error Resume Next
ThisWorkbook.SaveAs "\\qctnas\Google Drive\Production\" & FldrName & "\" & _
ThisFile & ".xlsm", 52
If ThisWorkbook.Saved = False Then ThisWorkbook.Save
On Error GoTo 0

到此：

ThisWorkbook.SaveAs "\\qctnas\Google Drive\Production\" & FldrName & "\" & _
ThisFile & ".xlsm", 52

使用VBA从网络打开工作簿时，Excel冻结

1 个答案: