从函数返回工作簿对象

Question

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

现在我收到错误："Run-time error 438: Object doesn't support this property or method." 来自这一行：

Set BookFromName = wb

我尝试将 return 类型切换为 Variant 或 Object，但没有任何改变。

我还尝试从行中删除 SET（即使这对我来说似乎不正确），这会将错误更改为 "Run-time error 91: Object variable or With block variable not set."

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

这是 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

我在 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 函数结束后仍然存在。

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

仅当您确定函数可以创建对象时才在函数内部创建对象，除非它 return 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 的代码很好，我会用他的。

要工作，您的代码需要更改如下（请参阅代码注释），希望这有助于您更好地理解您的代码。这是调用它的结果

? 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

非常重要的是要知道how/where您的函数将被调用。

当从 Sheet 个单元格 调用时 然后它不能 return 引用工作簿 （参见示例 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

从函数返回工作簿对象

Returning workbook object from function

excel

vba