檢查文件是否打開以防止出現錯誤

Question

我已經查看過，並且找不到具體的答案。下面的代碼提示用戶是否打開特定的文件。如果用戶點擊否，則子結束。如果他們點擊是，則子繼續。我已經測試了這個文件打開，所有的作品很好。但後來我忘了打開該文件，並根據提示是點擊並收到以下錯誤：

運行時錯誤「9」：

下標越界

對於此行的代碼：

隨着工作簿（「旋轉 - 主日 - 12月2015.xlsm」）。表（「旋轉」）

我明白爲什麼我得到的錯誤，但我該如何檢查，如果「是」回答用戶是真實的，以防止這個錯誤？

下面是完整的代碼：

Sub Extract_Sort_1512_December() 
' 
' 
    Dim ANS As String 
    ANS = MsgBox("Is the December 2015 Swivel Master File checked out of SharePoint and currently open on this desktop?", vbYesNo + vbQuestion + vbDefaultButton1, "Master File Open") 
    If ANS = vbNo Then 
     MsgBox "This procedure will now terminate.", vbOKOnly + vbExclamation, "Terminate Procedure" 
     Exit Sub 
    End If 

Application.ScreenUpdating = False 

    ' This line renames the worksheet to "Extract" 
    ActiveSheet.Name = "Extract" 

    ' This line autofits the columns C, D, O, and P 
    Range("C:C,D:D,O:O,P:P").Columns.AutoFit 

    ' This unhides any hidden rows 
    Cells.EntireRow.Hidden = False 

Dim LR As Long 

    For LR = Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1 
     If Range("B" & LR).Value <> "12" Then 
      Rows(LR).EntireRow.Delete 
     End If 
    Next LR 

With ActiveWorkbook.Worksheets("Extract").Sort 
    With .SortFields 
     .Clear 
     .Add Key:=Range("B2:B2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
     .Add Key:=Range("D2:D2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
     .Add Key:=Range("O2:O2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
     .Add Key:=Range("J2:J2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
     .Add Key:=Range("K2:K2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
     .Add Key:=Range("L2:L2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
    End With 
    .SetRange Range("A2:Z2000") 
    .Apply 
End With 
Cells.WrapText = False 
Sheets("Extract").Range("A2").Select 

    Dim LastRow As Integer, i As Integer, erow As Integer 

    LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row 
    For i = 2 To LastRow 
     If Cells(i, 2) = "12" Then 

      ' As opposed to selecting the cells, this will copy them directly 
      Range(Cells(i, 1), Cells(i, 26)).Copy 

      ' As opposed to "Activating" the workbook, and selecting the sheet, this will paste the cells directly 
      With Workbooks("Swivel - Master - December 2015.xlsm").Sheets("Swivel") 
       erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
       .Cells(erow, 1).PasteSpecial xlPasteAll 
      End With 
      Application.CutCopyMode = False 
     End If 
    Next i 

Application.ScreenUpdating = True 
End Sub 

我在這段代碼通過許多錯誤的工作在過去的兩天，我有點炒，所以任何幫助表示讚賞。

這裏是我的更新IF語句來檢查，以進行所需的工作簿的狀態：

Dim ANS As String 

    ANS = MsgBox("Is the November 2015 Swivel Master File checked out of SharePoint and currently open on this desktop?", vbYesNo + vbQuestion + vbDefaultButton1, "Master File Open") 
    If ANS = vbNo Then 
     MsgBox "This procedure will now terminate.", vbOKOnly + vbExclamation, "Terminate Procedure" 
     Exit Sub 
     ElseIf IsWBOpen("Swivel - Master - November 2015") Then 
    End If 

Answer 1

使用此功能檢查，如果需要的工作簿打開：

Function IsWBOpen(WorkbookName As String) As Boolean 
' check if WorkbookName is already opened; WorkbookName is without path or extension! 
' comparison is case insensitive 
' 2015-12-30 

    Dim wb As Variant 
    Dim name As String, searchfor As String 
    Dim pos as Integer 

    searchfor = LCase(WorkbookName) 
    For Each wb In Workbooks 
     pos = InStrRev(wb.name, ".") 
     If pos = 0 Then       ' new wb, no extension 
      name = LCase(wb.name) 
     Else 
      name = LCase(Left(wb.name, pos - 1)) ' strip extension 
     End If 
     If name = searchfor Then 
      IsWBOpen = True 
      Exit Function 
     End If 
    Next wb 
    IsWBOpen = False 
End Function 

它看起來通過（已打開）工作簿的列表，並將該名稱與它的參數進行比較。擴展名被剝離，沒有路徑前置，比較是不區分大小寫的。
用法：
If IsWbOpen("Swivel - Master - December 2015") then '... proceed Else Exit Sub End If