Question

我正在使用VBA w / Excel 2010并尝试创建（看起来应该是什么）一个简单的功能。我希望函数接收字符串参数，如果字符串与打开的工作簿的名称匹配，则返回对该工作簿对象的引用;如果未找到匹配项，则应返回＆＃34; #NAME？＆＃34;。（该功能还尝试连接常用文件扩展名以获得匹配，以方便用户使用。）

这就是它的样子：

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

现在我收到错误：＆＃34;运行时错误438：对象不支持此属性或方法。＆＃34; 来自此行：

Set BookFromName = wb

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

我也尝试从行中删除SET（即使这对我来说似乎不对），这会将错误更改为＆＃34;运行时错误91：对象变量或带块变量没有设置。＆＃34;

我扫描了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 （这是意外的，不合需要的）。

下面是以全名打开Workbook的功能。当然，需要添加错误处理程序。

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

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

从函数返回工作簿对象

5 个答案: