从函数返回工作簿对象

Question

我正在使用带有 Excel 2010 的 VBA，并正在尝试创建（看起来应该是）一个简单的函数。我希望该函数接收一个字符串参数，如果该字符串与打开的工作簿的名称匹配，则返回对该工作簿对象的引用；如果未找到匹配项，则应返回“#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：对象变量或未设置块变量。”

我扫描了 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

Answer 2

我建议使用如下函数：

Function IsWbkOpen(ByVal sName As String) As Boolean
Dim extensions As Variant, retVal As Boolean, wbk As Workbook
Dim i As Integer

retVal = False
extensions = Array("", ".xls", ".xslx", ".xlsm")

On Error Resume Next 'ignore errors

For i = LBound(extensions) To UBound(extensions)
    Set wbk = Application.Workbooks(sName & extensions(i))
    If Not wbk Is Nothing Then retVal = True: Exit For
Next

IsWbkOpen = retVal

End Function

然后你就可以创建程序了：

Sub Test()
Dim wbk As Workbook, wbkName As String

wbkName = "Workbook1"
If Not IsWbkOpen(wbkName) Then
    'call FileOpenDialog
End If

'proceed 

End Sub

仅当您确定该函数可以创建对象时才在函数内部创建对象，除非它会返回 Nothing（这是意外的，不受欢迎的）。

以下是按全名打开工作簿的函数。当然也需要添加Error handler。

Function CreateWbkFromName(ByVal sFullName As String) as Workbook

    If Dir(sFullName)<>"" Then
        Set CreateWbkFromName= Application.Workbooks.Open(sFullName)
    Else
        'here is a danger of Nothing
    End If
End Function

干杯，
马切耶

Answer 3

Maciej Los 的代码很好，我会用他的。

为了工作，你的代码需要改变如下（见代码 cmets），我希望这能帮助你更好地理解你的代码。这是调用它的结果

? BookFromName(thisworkbook.Name).Name
Book1
? BookFromName("Not open") is nothing
True



Function BookFromName(bookName As String) As Workbook

    Dim wb As Workbook

    For Each wb In Workbooks
        Select Case (wb.Name)
            Case bookName   
                ' NOTE  NO ":" IS NEEDED as it is a "command break" character 
                '       wb.Name does not return the file extension only the filename.
                Set BookFromName = wb                           ' SET ADDED
                Exit Function
         End Select
    Next

    MsgBox ("Workbook '" & bookName & "' is not open.")
    Set BookFromName = Nothing                                
               ' ADD SET AND USE NOTHING
               ' CVErr(xlErrName) would only be used if you are calling from an excel cell.
               ' As this returns and object this function will not be used 
               ' from excel 
               ' In the calling function test for is nothing to find if a workbook was found
End Function

Answer 4

你没有考虑区分大小写，所以试试这个：

Function BookFromName(bookName As String) As Workbook

Dim wb As Workbook
dim h$
bookName = Ucase (bookName)

For Each wb In Workbooks
        h = ucase (wb.name)
        if h = bookName & ".XLS" or h = bookName & ".XLSX" or h = bookName & ".XLSM" then 
            Set BookFromName = wb
            set wb = nothing
            Exit Function
        end if
Next wb

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

Answer 5

我在 Excel 2007 中尝试了您的第一个函数 Function BookFromName(bookName As String) As Workbook，它运行良好。我像下面一样运行它，同时打开 BS.xlsm。

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


Sub main()
 Dim wb As Workbook
 set wb = BookFromName("BS")
 MsgBox wb.Name
End Sub

或者，如何重写你的函数以通过引用传递参数

Sub BookFromName(bookName As String, byref wb as workbook)

无论你在 BookFromName 函数中为 wb 变量分配了什么，BookFromName 函数结束后它仍然存在。