MyTetra Share
Делитесь знаниями!
Выбор другой открытой книги для получения данных
Время создания: 16.03.2019 23:43
Текстовые метки: GetAnotherWorkbook, Обработка файлов, Обработка таблиц, Книги Excel, Workbook
Раздел: !Закладки - VBA - Excel
Запись: xintrea/mytetra_db_adgaver_new/master/base/151473439714iiobyyny/text.html на raw.githubusercontent.com

Выбор другой открытой книги для получения данных

Часто бывает, что надо получить данные из другой, открытой вместе с используемой, книги 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 просмотров

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

#1Игорь (администратор сайта), 3 Окт 2014 - 16:08.

Попробуйте так:

Sub Пример()
    Dim WB As Workbook
    Set WB = GetAnotherWorkbook
 
    If Not WB Is Nothing Then ' если книга открылась, то
    
        ' копируем столбцы
        WB.Worksheets(1).Columns("A:J").Copy ThisWorkbook.ActiveSheet.Range("A1")
 
        ' закрываем книгу-источник, если она больше не нужна
        WB.Close False
    End If
End Sub

PS: Ваш код слишком плох, чтобы использовать его во внешнем макросе (много лишнего с коде, - обратите внимание, я из вашего кода сделал одну строку)
И ещё, - копируя столбцы целиком, - я не понимаю, как из можно вставить, начиная с ячейки A2 (столбцы по высоте не влезут) - потому исправил A2 на A1

Так же в этом разделе:
 
MyTetra Share v.0.59
Яндекс индекс цитирования