从函数返回工作簿对象

我正在使用VBA W / Excel 2010，并试图创build（看起来应该是）一个简单的函数。 我想让函数接收一个string参数，如果string匹配打开工作簿的名称，则返回对该工作簿对象的引用; 如果找不到匹配，则应返回“#NAME？”。 （该function还会尝试连接常用文件扩展名以获得匹配，以便于用户使用。）

以下是它的样子：

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 

我尝试将返回types切换到Variant或Object，但它不会改变任何东西。

我也尝试从行中删除SET（即使这对我来说似乎不正确），它将错误更改为“运行时错误91：对象variables或未设置块variables”。

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

---

这里是Veve的build议，工作正常，但我宁愿传递引用：

 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

我build议使用像这样的function：

 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 

那么你将能够创build过程：

 Sub Test() Dim wbk As Workbook, wbkName As String wbkName = "Workbook1" If Not IsWbkOpen(wbkName) Then 'call FileOpenDialog End If 'proceed End Sub 

只有当你确定函数可以创build对象时才在函数内部创build对象，除非它将返回Nothing （这是意外的，不可取的）。

下面是以全名打开Workbook的function。 当然，需要添加error handling程序。

 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

我试过你的第一个函数函数BookFromName（bookName As String）作为工作簿在Excel 2007中，它工作正常。 我像下面这样运行，同时打开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中分配了wbvariables，它在BookFromName函数结束后仍然存在。