vba - 从函数返回工作簿对象

Question

我正在使用 VBA 和 Excel 2010，并尝试创建(看起来应该是)一个简单的函数。我希望该函数接收一个字符串参数，如果该字符串与打开的工作簿的名称匹配，则返回对该工作簿对象的引用；如果未找到匹配项，则应返回“#NAME?”。 (该函数还尝试连接常见的文件扩展名来获得匹配，以方便用户使用。)

它看起来像这样:

Function BookFromName(bookName As String) As Workbook

    Dim wb As Workbook

    For Each wb In Workbooks
        Select Case (wb.Name)
            Case bookName, _
                bookName & ".xls", _
                bookName & ".xlsx", _
                bookName & ".xlsm":
                Set BookFromName = wb
                Exit Function
         End Select
    Next

    MsgBox ("Workbook '" & bookName & "' is not open.")
    BookFromName = CVErr(xlErrName)
End Function

现在我收到错误:“运行时错误 438:对象不支持此属性或方法。” 从这一行:

Set BookFromName = wb

我尝试将返回类型切换为 Variant 或 Object，但它没有改变任何内容。

我还尝试从该行中删除 SET(尽管这对我来说似乎不正确)，这将错误更改为“运行时错误 91:未设置对象变量或 With block 变量。”

我扫描了 Google 和 StackExchange 一段时间，但找不到任何返回工作簿对象的函数示例，而不仅仅是工作簿的名称。

---

这是 Veve 的建议，效果很好，但我更愿意传递引用:

Function BookFromName(bookName As String) As Variant

    Dim wb As Workbook

    For Each wb In Workbooks
        Select Case (wb.Name)
            Case bookName, _
                bookName & ".xls", _
                bookName & ".xlsx", _
                bookName & ".xlsm":
                BookFromName = wb.Name
                Exit Function
        End Select
    Next
    MsgBox ("Workbook '" & bookName & "' is not open.")
    BookFromName = CVErr(xlErrName)
End Function

Answer 1

了解如何/在何处调用您的函数非常重要。

• 当从工作表单元格调用时，它无法返回对工作簿的引用(参见示例 BookFromName1)
• 当从其他 VBA 代码中调用时，不应使用 CVErr(参见示例 BookFromName2)

注意:使用 Like 可以省略工作簿名称扩展名。

HTH

' As 'User Defined Function' (functions that are called directly from worksheet cells)
Function BookFromName1(bookName As String) As Variant

    On Error Resume Next
    Dim tempWorkbook As Workbook
    Dim isOpen As Boolean
    Dim bookNameLike As String
    bookNameLike = LCase(bookName) & "*"
    For Each tempWorkbook In Workbooks
        If LCase(tempWorkbook.Name) Like bookNameLike Then
            isOpen = True
            Exit For
        End If
    Next
    On Error GoTo 0

    If Not isOpen Then
        MsgBox ("Workbook '" & bookName & "' is not open.")

        ' return error #NAME? to the cell which called this formula
        BookFromName1 = CVErr(xlErrName)
    Else
        ' returns TRUE to the cell which called this formula
        BookFromName1 = True
    End If
End Function

' As common VBA function (used in another VBA code)
Function BookFromName2(bookName As String) As Workbook

    On Error Resume Next
    Dim tempWorkbook As Workbook
    Dim bookNameLike As String
    bookNameLike = LCase(bookName) & "*"
    For Each tempWorkbook In Workbooks
        If LCase(tempWorkbook.Name) Like bookNameLike Then
            Set BookFromName2 = tempWorkbook
            Exit For
        End If
    Next
    On Error GoTo 0

    If BookFromName2 Is Nothing Then
        Dim errorMessage As String
        errorMessage = "Workbook '" & bookName & "' is not open."
        MsgBox errorMessage
        ' In this case (differently from UDF) you can't use CVErr
        ' but you could raise error if you wish.
        ' (Or outcomment Err.Raise and simply return Nothing.)
        Err.Raise vbObjectError + 513, "BookFromName2", errorMessage
    End If
End Function

Sub TestBookFromName2()
    Dim myBook As Workbook
    On Error GoTo errHandler
    ' Like is used to compere book names so the .xls, .xlsx etc. can be omitted
    Set myBook = BookFromName2("SomeBookNameHere")
    Exit Sub
errHandler:
    MsgBox Err.Description, vbExclamation
End Sub