Часто бывает, что надо получить данные из другой, открытой вместе с используемой, книги Excel.

Данная функция помогает получить ссылку на другую, открытую в текущий момент, книгу:

Sub ПримерИспользования_GetAnotherWorkbook()

    Dim WB As Workbook

    Set WB = GetAnotherWorkbook

    If Not WB Is Nothing Then

        MsgBox "Выбрана книга: " & WB.FullName, vbInformation

    Else

        MsgBox "Книга не выбрана", vbCritical: Exit Sub

    End If

    ' обработка данных из выбранной книги

    x = WB.Worksheets(1).Range("a2")

    ' ...

End Sub

Function GetAnotherWorkbook() As Workbook

    ' если в данный момент открыто 2 книги, функция возвратит вторую открытую книгу

    ' если помимо текущей, открыто более одной книги - будет предоставлен выбор

    On Error Resume Next

    Dim coll As New Collection, WB As Workbook

    For Each WB In Workbooks

        If WB.Name <> ThisWorkbook.Name Then

            If Windows(WB.Name).Visible Then coll.Add CStr(WB.Name)

        End If

    Next WB

    Select Case coll.Count

        Case 0    ' нет других открытых книг

            MsgBox "Нет других открытых книг", vbCritical, "Function GetAnotherWorkbook"

        Case 1    ' открыта ещё только одна книга - её и возвращаем

            Set GetAnotherWorkbook = Workbooks(coll(1))

        Case Else    ' открыто несколько книг - предоставляем выбор

            For i = 1 To coll.Count

                txt = txt & i & vbTab & coll(i) & vbNewLine

            Next i

            msg = "Выберите одну из открытых книг, и введите её порядковый номер:" & _

                  vbNewLine & vbNewLine & txt

            res = InputBox(msg, "Открыто более двух книг", 1)

            If IsNumeric(res) Then Set GetAnotherWorkbook = Workbooks(coll(Val(res)))

    End Select

End Function

• 23766 просмотров