excel - 当 Excel 被锁定在过程中时，在 Excel 按钮上中断子例程

Question

我编写了一个 VBA 过程(在 Excel 2010 中启动)，它循环包含不同 Excel 文件的数组。该循环打开文件，刷新数据，保存并关闭数组中每个项目的文件。该过程最多可能需要 90 分钟才能完成，因此我需要一个安全的中断例程，它将在当前迭代完成时停止该过程。

我将代码包含在 do-while 循环中，并将 bool 值初始化为 False。我在 Excel 中创建了一个“停止”按钮，按下该按钮时将 bool 变量设置为 True，以便满足 do while 条件并停止该过程。

停止按钮基于同一个 Excel 文件，该文件初始化打开和关闭 Excel 文件的过程。 这意味着 Excel 实例已锁定，因此用户无法按中断按钮并停止该过程。

如何访问停止按钮？或者有其他方法来启动休息吗？

我的代码 - 添加于 06/06/2014 15:12

Sub Refresh_Weekly()
failedIndex = 0
'DoEvents
'Refresh_StandardWeekly ' module 2
'Refresh_NonStandardWeekly ' module 4
Refresh_CRIS ' module 3

If StopMsg <> "" Then
    MsgBox StopMsg

    ElseIf failedIndex = 0 Then
        MsgBox "All Weekly Pivots refreshed"
    Else
        For x = 0 To failedIndex - 1
        OutputMsg = OutputMsg + Failed(x) & ", "
        Next x
    MsgBox "Pivots which failed to refresh:" & OutputMsg
End If
Erase Failed
OutputMsg = ""
End Sub

<小时/>

Sub Refresh_CRIS()

Dim routepath As String
routepath = "\\nch\dfs\SharedArea\Private\BIS\Groups\KPI-Group\Pivots\"

ChDir routepath

Dim CRISPiv As Variant 'Includes Dailies
Dim i
Dim errorText As String
Dim x
Dim objXL As Excel.Application
Set objXL = CreateObject("Excel.Application")
UserForm1.Show vbModeless
Ref = True

CRISPiv = Array("Waiting-List-Diagnostic.xls", "Cancer_PTL Position.xls")

Do While Ref
DoEvents

For Each i In CRISPiv
    If File_Exists(routepath & i) Then
        If isFileOpen(i) = True Then
        errorText = i
        Failed(failedIndex) = errorText
        failedIndex = failedIndex + 1
        Else

        objXL.Visible = False
        objXL.Workbooks.Open Filename:=routepath & i
            If objXL.ActiveWorkbook.ReadOnly = False Then
            objXL.ActiveWorkbook.RefreshAll
            objXL.Application.CalculateFull
            objXL.Application.DisplayAlerts = False
            objXL.ActiveWorkbook.Save
            objXL.Application.DisplayAlerts = True
            objXL.Quit

            Else
            errorText = i
            Failed(failedIndex) = errorText
            failedIndex = failedIndex + 1
            objXL.Application.DisplayAlerts = False
            objXL.Quit
            Application.DisplayAlerts = True
            End If
        End If
    Else
    errorText = i
    Failed(failedIndex) = errorText
    failedIndex = failedIndex + 1
    End If

Next i
Ref = False
Loop

Unload UserForm1

Exit Sub

Resume Next

End Sub

<小时/>

Public RefStop As Boolean
Public StopMsg As String

Sub Refresh_Stop_Test_Click()

Ref = False
StopMsg = "Refresh Cancelled"

End Sub

<小时/>

下面是我的代码的经过高度修改的版本，我试图尽可能地匹配 @David 的代码，但它仍然不起作用。我需要在 Foreach 语句完成后添加 boo = False 否则它会循环到无穷大。我还添加了一个简单的消息框来测试按钮是否有效。其他一切都一样，但表单不允许我按下按钮。如果我多次按下该按钮的位置(想想令人沮丧的大型点击)，当代码完成并弹出“Fine”消息时，它会发出相应次数的蜂鸣声，因此它显然没有处理我的输入。

代码:

公共(public) boo 作为 bool 值

Sub Refresh_CRIS()

Dim objXL As Excel.Application
Dim i, CRISPiv
Set objXL = CreateObject("Excel.Application")

CRISPiv = Array("C:/Temp/test/Book1.xlsm", "C:/Temp/test/Book2.xlsm")
UserForm1.Show vbModeless

boo = True

Do While boo
    DoEvents
    For Each i In CRISPiv
        objXL.Visible = False
        objXL.Workbooks.Open i
        objXL.ActiveWorkbook.Save
        objXL.Quit
    Next
boo = False

Loop

Unload UserForm1
If StopMsg <> "" Then
MsgBox StopMsg

Else: MsgBox "Fine"
End If

结束子

指向我的 Excel 控制文件的 Dropbox 链接:

Excel Control file

Answer 1

这有点麻烦，但你可以写

VBA.DoEvents

在你的紧密循环中。基本上这会等待用户界面事件队列刷新。这将允许您单击停止按钮、处理其事件并设置适当的 bool 标志。