Question

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

我在do-while循环中包含了代码，其中boolean初始化为False。我在Excel中创建了一个Stop按钮，在按下时将布尔变量设置为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的代码，但它仍然不起作用。我需要在我的每个语句完成之后添加boo = False，否则它将循环到无穷大。我还添加了一个简单的msgbox来测试按钮是否有效。其他一切都是一样的，但表格不允许我按下按钮。如果我按下按钮多次（想想沮丧的超级点击），当代码完成并弹出“精细”消息时，它会发出多次嘟嘟声，因此显然不会处理我的输入。

代码：

Public boo As Boolean

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

End Sub

Dropbox链接到我的Excel控件文件：

Excel Control file

Answer 1

这有点像黑客，但你可以写

VBA.DoEvents

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

Answer 2

你能不能为运行每个文件创建一个新的excel实例？会让你的主实例被释放，并且意味着你可以随时点击按钮（前提是它是非模态形式 - 或者它是模态的吗？总是让它们混淆起来：P）它会完成一个它在它自己的实例中，并没有继续循环的其余部分。

编辑：以下是一个excel文件示例：http://we.tl/Hcfce2PnWv

Answer 3

用户形式示例：

在普通代码模块中：

Public boo As Boolean
Sub Test()
Dim objXL As Excel.Application
Dim i, CRISPiv
Set objXL = CreateObject("Excel.Application")

CRISPiv = Array("C:/users/david_zemens/desktop/Book2.xlsx", "C:/users/david_zemens/desktop/vacation planning.xlsm")
UserForm1.Show vbModeless

boo = True
'infinite loop

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

Loop

Unload UserForm1

End Sub

在userform模块中将此项指定给按钮的_Click事件处理程序，只需将boo设置为False。

Private Sub CommandButton1_Click()
boo = False
End Sub

程序Test是一个无限循环，只能终止boo = False。

Answer 4

从您的代码修改：

Public ref As Boolean
Sub Refresh_CRIS()
    On Error GoTo Errorhandler

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")
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

DoEvents
If ref = False Then
Exit For
End If
Next i

Unload UserForm1
Debug.Print ref 'put this in to see how the code is exiting
Exit Sub

Errorhandler:

errorText = i
Failed(failedIndex) = errorText
failedIndex = failedIndex + 1

Resume Next
End Sub

将你的DoEvents移动到for循环的末尾，因为它完全不起作用。通过这种方式，它至少会完成整个程序，并且不会在现有纸张上部分更新数据的情况下进一步导致潜在错误。

现在正在测试

在Excel程序中锁定Excel时，在Excel按钮上中断子程序

End Sub

4 个答案: