Возвращаемый объект рабочей книги из функции

Question

Я использую VBA w/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 или объекта, но это ничего не меняет.

Я также попытался удалить 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 расширение имени рабочей книги может быть опущен.

НТН

' 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

Я пробовал свою первую функцию Функция BookFromName (BookName As String) Как Workbook в 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 в книге)

все, что вы назначили Wb переменной в функции BookFromName , он все еще существует после завершения функции BookFromName.

Answer 3

Я хотел бы предложить использовать функцию, как:

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 

Создание объектов внутри функции только тогда, когда вы уверены, что функция может создать объект , если он не вернет Ничего (что неожиданно, нежелательно).

Ниже представлена ​​функция, которая открывает Рабочую книгу по ее полному названию. Конечно, нужно добавить обработчик ошибок.

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 

Cheers,
Maciej

Answer 4

Код Мачей Лос-хорошо, я хотел бы использовать его.

Чтобы работать, ваш код нуждается в изменении следующим образом (см. Комментарии к коду), я надеюсь, что это поможет вам лучше понять ваш код. Вот результаты вызова он

? 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 5

вы не рассматривали дела чувствительное, поэтому попробуйте вместо этого:

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