Lost your password?


Хитрости »
Основные понятия (27)
Сводные таблицы и анализ данных (10)
Графики и диаграммы (5)
Работа с VB проектом (12)
Power BI и Power Query (23)
Условное форматирование (5)
Списки и диапазоны (5)
Макросы(VBA процедуры) (68)
Разное (43)
Баги и глюки Excel (5)

Получить адрес активной ячейки неактивного листа

В чем суть вопроса: надо получить адреса ячеек/диапазонов неактивного листа. Получить адрес ячейки активного листа просто:

Sub GetActiveCellAddress()
    MsgBox ActiveCell.Address, vbInformation
End Sub

Но вот для неактивного листа такой метод не подойдет. Следовательно необходимо активировать каждый лист книги и уже после этого считывать адрес ячейки:

Sub Get_ActCellAddress()
    Dim wsSh As Worksheet, lR As Long, lC As Long
    Dim avRes, lCnt As Long
 
    ReDim avRes(1 To ActiveWorkbook.Worksheets.Count, 1 To 4)
    For Each wsSh In ActiveWorkbook.Worksheets
        wsSh.Select
        lCnt = lCnt + 1
        avRes(lCnt, 1) = wsSh.Name
        avRes(lCnt, 2) = ActiveCell.Row
        avRes(lCnt, 3) = ActiveCell.Column
        avRes(lCnt, 4) = Selection.Address
    Next wsSh
 
    If lCnt Then
        Cells(1, 1).Resize(, 4).Value = Array("Имя листа", "Строка", "Столбец", "Адрес выделения")
        Cells(2, 1).Resize(lCnt, 4).Value = avRes
    End If
End Sub

Но по сути мы не получаем адрес ячейки неактивного листа, а каждый раз активируем лист и получаем адрес активной ячейки активного листа. Я лично не вижу недостатков у этого метода, т.к. для практического применения это самый лучший вариант.
Однако ниже приведен код, который написан исключительно из спортивного интереса, т.к. подобный вопрос периодически все же возникает как на моих тренингах по VBA, так и на форумах. Основан он на том, что любая книга Excel может представлять из себя XML-документ, в котором все нужные нам данные есть. Но есть и очень неудобный нюанс - книгу обязательно необходимо сохранить в формате XML.
Остальные нюансы именно приведенного ниже кода:

  • книга должна быть закрыта(точнее XML-документ);
  • книга называется Книга1.xls и располагается в той же папке, что и книга с кодом.

Код открывает книгу Книга1.xls, сохраняет её в формат XML и далее считывает XML-схему.
В общем ниже подробный код с небольшими комментариями - может кому пригодится для каких-то целей:

Sub GetActiveRange_fromXML()
    Dim xmlDoc As Object, xmlRNode As Object, xmlWs_Node As Object
    Dim li As Long
    Dim avTmp(), avRes(), lCnt As Long
    Dim sFileName As String, sNewFileName As String, sExtens As String, s As String
    Dim asNodes
 
    sFileName = ThisWorkbook.Path & "\Книга1.xls"
    sExtens = Mid(sFileName, InStrRev(sFileName, "."))
    sNewFileName = Replace(sFileName, sExtens, ".xml")
    Application.DisplayAlerts = 0
    Workbooks.Open sFileName
    'сохраняем книгу как XML
    ActiveWorkbook.SaveAs sNewFileName, xlXMLSpreadsheet
    'закрываем книгу, чтобы затем не было конфликта
    ActiveWorkbook.Close 0
    Application.DisplayAlerts = 1
    'используем встроенные возможности VBA для чтения схем XML
    Set xmlDoc = CreateObject("Microsoft.xmldom")
    xmlDoc.async = False
    If Not xmlDoc.Load(sNewFileName) Then
        MsgBox "Возникла ошибка при загрузке файла. Возможно, файл испорчен.", vbInformation, "www.excel-vba.ru"
        Exit Sub
    End If
    'цикл по узлам схемы с отбором только нужных нам
    asNodes = Array("ActiveRow", "ActiveCol", "RangeSelection")
    For Each xmlRNode In xmlDoc.SelectNodes("Workbook/Worksheet/*")
        s = xmlRNode.BaseName
        If s = "WorksheetOptions" Then
            ReDim avTmp(0 To 3)
            avTmp(0) = xmlRNode.ParentNode.Attributes(0).Text 'имя листа
            avTmp(1) = 1
            avTmp(2) = 1
            For li = LBound(asNodes) To UBound(asNodes)
                Set xmlWs_Node = xmlRNode.SelectSingleNode("Panes/Pane/" & asNodes(li))
                If Not xmlWs_Node Is Nothing Then
                    avTmp(li + 1) = xmlWs_Node.nodeTypedValue
                    If li < 2 Then
                        avTmp(li + 1) = avTmp(li + 1) + 1
                    End If
                End If
            Next li
            If avTmp(3) = "" Then avTmp(3) = Cells(avTmp(1), avTmp(2)).Address(, , xlR1C1)
            lCnt = lCnt + 1
            ReDim Preserve avRes(lCnt - 1)
            avRes(lCnt - 1) = avTmp
        End If
    Next
    'выгружаем на лист полученные данные
    If lCnt Then
        Cells(1, 1).Resize(, UBound(avTmp) + 1).Value = Array("Имя листа", "Строка", "Столбец", "Адрес выделения")
        For li = LBound(avRes) To UBound(avRes)
            Cells(li + 2, 1).Resize(, UBound(avTmp) + 1).Value = avRes(li)
        Next li
    End If
End Sub

Статья помогла? Поделись ссылкой с друзьями!
  Плейлист   Видеоуроки

Поиск по меткам

Access apple watch Multex Power Query и Power BI VBA управление кодами Бесплатные надстройки Дата и время Записки ИП Надстройки Печать Политика Конфиденциальности Почта Программы Работа с приложениями Разработка приложений Росстат Тренинги и вебинары Финансовые Форматирование Функции Excel акции MulTEx ссылки статистика
Обсуждение: 3 комментария
  1. Борис:

    А как можно получить из объекта Range имя листа где этот диапазон находиться?

Поделитесь своим мнением

Комментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум


Для оформления сообщений Вы можете использовать следующие тэги:
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

Тренинги

Заказать
Юридическая информация

Использование материалов сайта

Политика Конфиденциальности

ИП Щербаков Дмитрий Валентинович
ОГРНИП: 318502700083307
ИНН: 504013350772

Наши партнеры

Перейти

Счетчики

Рейтинг@Mail.ru Яндекс.Метрика
© 2024 Excel для всех   Войти