Question

我已经看过了，但却找不到具体的答案。以下代码提示用户是否打开了特定文件。如果用户单击否，则子结束。如果他们单击是，则子继续。我已经测试了这个文件打开，一切都很好。但后来我忘记打开文件并在提示时单击是并收到以下错误：

运行时错误＆＃39; 9＆＃39;：

下标超出范围

对于代码中的这一行：

使用工作簿（＆＃34; Swivel - Master - 2015年12月xlsm＆＃34;）。表格（＆＃34; Swivel＆＃34;）

我理解为什么我会收到错误，但我如何检查＆＃34;是＆＃34;来自用户的回答是否可以防止此错误？

以下是完整代码：

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

检查文件是否已打开以防止错误

1 个答案: