当Excel被locking在程序中时，打开Excelbutton上的子程序

我已经编写了一个VBA过程（在Excel 2010中启动），它围绕包含不同Excel文件的数组进行循环。 循环打开文件，刷新数据，保存并closuresarrays中每个项目的文件。 这个过程可能需要90分钟才能完成，所以我想要一个安全的中断程序，当当前的迭代完成后，程序将停止。

我在一个do-while循环中包含了一个初始化为False的布尔值的代码。 我在Excel中创build了一个停止button，当按下时将布尔variables设置为True，以满足do while条件并停止该过程。

停止button基于相同的Excel文件，它初始化打开和closuresExcel文件的过程。 这意味着excel实例被locking，所以用户不能按下breakbutton并暂停程序。

我怎样才能访问停止button？ 还是有其他方法来启动rest？

我的代码 – 新增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来testingbutton的工作。 一切都是一样的，但forms不会让我按下button。 如果我按了多次button（想想沮丧巨大的点击），当代码完成，并popup“罚款”味精哔哔次数，所以显然不处理我的input。

码：

公众嘘声布尔

 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 

结束小组

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

Excel控制文件

Answer 1

从您的代码修改：

 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循环的末尾，因为它不能在其中运行。 这样，它至less也会经历整个例程，并且不会在现有工作表上部分刷新数据的情况下进一步导致潜在的错误。

现在正在testing工作

Answer 2

这是一个黑客，但你可以写

VBA.DoEvents

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

Answer 3

你能不能创build一个新的Excel实例运行每个文件？ 将主要实例释放，并意味着你可以随时点击button（只要它是一个非模态的forms – 或者是模态？总是让他们混合起来：P），它会完成一个它是在自己的实例，并没有继续其余的循环。

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

Answer 4

用户表单示例：

在正常的代码模块中：

 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 

在用户表单模块中，将此分配给button的_Click事件处理程序，只需将boo设置为False即可。

 Private Sub CommandButton1_Click() boo = False End Sub 

程序Test是一个无限循环，只能以boo = False结束。