Excel vba list open windows

Автор: Силувия Последнее изменение: 2024 июля 10 г.

Фактически, вы можете перечислить все открывающиеся приложения, которые отображаются только при нажатии клавиш Alt + Tab на вашем компьютере в Excel с запущенным кодом VBA. Метод, описанный в статье, может вам помочь.

Список всех открытых (запущенных в данный момент) приложений с кодом VBA


Список всех открытых (запущенных в данный момент) приложений с кодом VBA

Пожалуйста, сделайте следующее, чтобы перечислить все открытые приложения в Excel.

1. В книге Excel нажмите другой + F11 клавиши одновременно, чтобы открыть Microsoft Visual Basic для приложений окно.

2. в Microsoft Visual Basic для приложений окно, нажмите Insert > Модули. Затем скопируйте и вставьте код VBA в окно кода. Смотрите скриншот:

нажмите «Вставить» data-lazy-src=

Код VBA: список всех открытых приложений в Excel

Private Declare PtrSafe Function apiGetClassName Lib "user32" Alias _
                "GetClassNameA" (ByVal Hwnd As Long, _
                ByVal lpClassname As String, _
                ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function apiGetDesktopWindow Lib "user32" Alias _
                "GetDesktopWindow" () As Long
Private Declare PtrSafe Function apiGetWindow Lib "user32" Alias _
                "GetWindow" (ByVal Hwnd As Long, _
                ByVal wCmd As Long) As Long
Private Declare PtrSafe Function apiGetWindowLong Lib "user32" Alias _
                "GetWindowLongA" (ByVal Hwnd As Long, ByVal _
                nIndex As Long) As Long
Private Declare PtrSafe Function apiGetWindowText Lib "user32" Alias _
                "GetWindowTextA" (ByVal Hwnd As Long, ByVal _
                lpString As String, ByVal aint As Long) As Long
Private Const mcGWCHILD = 5
Private Const mcGWHWNDNEXT = 2
Private Const mcGWLSTYLE = (-16)
Private Const mcWSVISIBLE = &H10000000
Private Const mconMAXLEN = 255

Sub ListName()
    Dim xRg As Range
    Dim xStr As String
    Dim xStrLen As Long
    Dim xHandle As Long
    Dim xHandleStr As String
    Dim xHandleLen As Long, xHandleStyle As Long
    On Error Resume Next
    Set xRg = Application.InputBox("Please select a range(single cell):", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    xRg(1).Activate
    xHandle = apiGetWindow(apiGetDesktopWindow(), mcGWCHILD)
    Do While xHandle <> 0
        xStr = String$(mconMAXLEN - 1, 0)
        xStrLen = apiGetWindowText(xHandle, xStr, mconMAXLEN)
        If xStrLen > 0 Then
            xStr = Left$(xStr, xStrLen)
            xHandleStyle = apiGetWindowLong(xHandle, mcGWLSTYLE)
            If xHandleStyle And mcWSVISIBLE Then
                ActiveCell.Value = xStr
                ActiveCell.Offset(1, 0).Activate
            End If
        End If
        xHandle = apiGetWindow(xHandle, mcGWHWNDNEXT)
    Loop
End Sub

3. нажмите F5 ключ для запуска кода. В всплывающем Kutools for Excel диалоговом окне выберите ячейку, в которой вы хотите перечислить все запущенные приложения, а затем щелкните OK кнопка. Смотрите скриншот:

выберите ячейку для отображения списка всех запущенных приложений

Теперь все открывающиеся приложения сразу отображаются в выбранном столбце, как показано на скриншоте ниже.

все вступительные заявления перечислены

Разблокируйте магию Excel с помощью Kutools AI

  • Умное исполнение: выполнение операций с ячейками, анализ данных и создание диаграмм — и все это осуществляется с помощью простых команд.
  • Пользовательские формулы: Создавайте индивидуальные формулы для оптимизации рабочих процессов.
  • VBA-кодирование: Пишите и внедряйте код VBA без особых усилий.
  • Интерпретация формулы: Легкое понимание сложных формул.
  • Перевод текста: преодолевайте языковые барьеры в своих таблицах.

Расширьте свои возможности Excel с помощью инструментов на базе искусственного интеллекта. Скачать сейчас и испытайте эффективность, как никогда раньше!


Статьи по теме:

  • Как перечислить все совпавшие экземпляры значения в Excel?
  • Как указать все дни как дату в указанном месяце в Excel?

Лучшие инструменты для офисной работы

🤖 Kutools AI Помощник: Революционный анализ данных на основе: Интеллектуальное исполнение   |  Генерировать код  |  Создание пользовательских формул  |  Анализ данных и создание диаграмм  |  Вызов функций Kutools…
Популярные опции: Найдите, выделите или определите дубликаты   |  Удалить пустые строки   |  Объедините столбцы или ячейки без потери данных   |   Раунд без формулы …
Супер поиск: Множественный критерий VLookup    VLookup с несколькими значениями  |   VLookup по нескольким листам   |   Нечеткий поиск ….
Расширенный раскрывающийся список: Быстрое создание раскрывающегося списка   |  Зависимый раскрывающийся список   |  Выпадающий список с множественным выбором ….
Менеджер столбцов: Добавить определенное количество столбцов  |  Переместить столбцы  |  Переключить статус видимости скрытых столбцов  |  Сравнить диапазоны и столбцы …
Рекомендуемые функции: Сетка Фокус   |  Просмотр дизайна   |   Большой Формулный Бар    Менеджер книг и листов   |  Библиотека ресурсов (Авто текст)   |  Выбор даты   |  Комбинировать листы   |  Шифровать/дешифровать ячейки    Отправлять электронные письма по списку   |  Суперфильтр   |   Специальный фильтр (фильтровать жирным шрифтом/курсивом/зачеркиванием…) …
15 лучших наборов инструментов12 Текст Инструменты (Добавить текст, Удалить символы, …)   |   50+ График Тип (Диаграмма Ганта, …)   |   40+ Практических Формулы (Рассчитать возраст по дню рождения, …)   |   19 Вносимые Инструменты (Вставить QR-код, Вставить изображение из пути, …)   |   12 Конверсия Инструменты (Числа в слова, Конверсия валюты, …)   |   7 Слияние и разделение Инструменты (Расширенные ряды комбинирования, Разделить клетки, …)   |   … и более

Используйте Kutools на предпочитаемом вами языке — поддерживаются английский, испанский, немецкий, французский, китайский и более 40 других языков!

Улучшите свои навыки работы с Excel с помощью Kutools for Excel и почувствуйте эффективность, как никогда раньше. Kutools for Excel предлагает более 300 расширенных функций для повышения производительности и экономии времени.  Нажмите здесь, чтобы получить функцию, которая вам нужна больше всего…


Вкладка Office: интерфейс с вкладками в Office и упрощение работы

  • Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
  • Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
  • Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!

 

aesp

Пользователь

Сообщений: 147
Регистрация: 09.03.2015

Здравствуйте!

Помогите с рабочим кодом, с помощью которого можно получить СПИСОК НАИМЕНОВАНИЙ открытых в данный момент программных ОКОН (окон приложений) и окон документов (вторичных окон). Весь инет «прошерстил» — нет ничего вразумительного.

Благодарю!

 

The_Prist

Пользователь

Сообщений: 15487
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

#2

09.11.2017 10:20:31

Что в Вашем понимании «Наименование окна»? То, что написано в заголовке? Или что?

Цитата
aesp написал:
Весь инет «прошерстил» — нет ничего вразумительного

Так поделитесь тем, что нашли и почему оказалось «не тем». Потому как примеров куча, только что проверил, вбив в поисковик «список всех окон vba». Что для Вас является вразумительным?
Вполне неплохо должно все это получиться при помощи API. Но тут уже неясна цель конечная. Получили список окон. Дальше что с ним делать?

И при чем здесь Excel вообще?

P.S. И Вы в курсе, что все окна — это очень большой список, т.к. даже панель задач со всеми прогами там — это тоже все окна? Т.е. по сути это будет диспетчер задач, т.к. Windows не просто так называется именно Windows(окна), а именно потому, что практически любой процесс представляет собой окно…

Изменено: The_Prist09.11.2017 10:38:54

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

 

aesp

Пользователь

Сообщений: 147
Регистрация: 09.03.2015

#3

09.11.2017 11:25:41

The_Prist, да, в моём понимании «наименование окна» — то, что в заголовке его вижу. Нужны те окна которые я вижу на фоне рабочего стола. Если что-то другое можно отнести к «наименованию окна», то тогда нужен список этих «наименований». Цель «конечная» моя
никому не интересна. А промежуточная — переключиться в нужное окно по его числовому hwnd:

Код
hwnd = FindWindow(vbNullString, "Книга1")
Код
J = SetForegroundWindow(ByVal hwnd)

Этим кодом переключаюсь в окно открытого файла Excel с именем «Книга1», а вот уже в окно файла в общем доступе «Книга1 [Общий]» или «Книга2 [Режим совместимости]» попасть не удаётся… Предполагаю, что «настоящие» имена окон совсем иные, чем вижу в их заголовке.
Вся эта

Цитата
The_Prist написал:
примеров куча

реально не работает, при запуске макросов на их основе. Был бы «профи» — молча бы из кучи создал конфетку.
Да, я в курсе про Windows вообще. ПредлОжите другой способ переключения в нужное окно — спасибо. Только ответ типа «здесь трактор нужен» — не подойдёт.[/SIZE]
Так как всё-таки прийти к пункту:

Цитата
The_Prist написал: Получили список окон.

 

Изменено: aesp09.11.2017 13:02:47

 

Hugo

Пользователь

Сообщений: 26259
Регистрация: 22.12.2012

#4

09.11.2017 11:39:43

Цитата
aesp написал:
переключаюсь в окно открытого файла Excel с именем «Книга1»,

— таких окон может быть много, раз уж пошли в дебри API…

 

The_Prist

Пользователь

Сообщений: 15487
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

#5

09.11.2017 11:48:41

Цитата
aesp написал:
Только ответ типа «здесь трактор нужен» — не подойдёт.

И что это значит? Какие тракторы, Вы о чем?

Цитата
aesp написал:
никому не интересна

Ну тогда сами крутите код ниже, раз считаете, что нам ответы на наши вопросы не интересны:

Код
Option Explicit

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal _
                        lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long

Public Const GW_HWNDFIRST = 0
Public Const GW_HWNDNEXT = 2

Sub GetTaskList()
    Dim lw As Long, s As String, CurrWnd As Long
    CurrWnd = GetWindow(Application.hwnd, GW_HWNDFIRST)
    Do While CurrWnd <> 0
        lw = GetWindowTextLength(CurrWnd)
        s = Space(lw + 1)
        lw = GetWindowText(CurrWnd, s, lw + 1)
        If lw > 0 Then
            Debug.Print Trim(s)
        End If
        CurrWnd = GetWindow(CurrWnd, GW_HWNDNEXT)
        DoEvents
    Loop
End Sub

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

 

aesp

Пользователь

Сообщений: 147
Регистрация: 09.03.2015

#6

09.11.2017 11:52:17

Цитата
Hugo написал:
таких окон может быть много

Что это значит? Каких таких? Я ТОЧНО и конкретно получаю номер окна файла «Книга1». Нельзя открыть 10 окон с одинаковым именем. Вопрос в том, почему не все окна «отлавливаются» используемым мной способом? Да «пофиг» как эти дебри называются, — есть инструмент? Нельзя получить список окон? — скажите «НЕЛЬЗЯ!»

 

The_Prist

Пользователь

Сообщений: 15487
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

#7

09.11.2017 12:04:15

Цитата
aesp написал:
скажите «НЕЛЬЗЯ!»

Код выше. Получайте названия, обращайтесь. Делайте с ним что хотите.

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

 

Hugo

Пользователь

Сообщений: 26259
Регистрация: 22.12.2012

#8

09.11.2017 12:10:37

Цитата
aesp написал:
Нельзя открыть 10 окон с одинаковым именем.

— почему? Раз Вы полезли так глубоко, а не копаете в одном приложении, значит это не просто так, значит приложений может быть много, и в каждом вполне может быть такое окно.
Ну а если приложение всегда одно — так зачем так усложнять? Берите целиком коллекцию Workbooks()

Изменено: Hugo09.11.2017 14:14:02
(конечно же workbooks())

 

aesp

Пользователь

Сообщений: 147
Регистрация: 09.03.2015

#9

09.11.2017 12:23:22

The_Prist,

Цитата
The_Prist написал:
считаете, что нам ответы на наши вопросы не интересны:

да, вроде, на все Ваши вопросы ответил — без обид? Спасибо за код, НО запускаю — и ничего не происходит… где список увидеть? Увижу результат, смогу «прикрутить»    

 

Андрей VG

Пользователь

Сообщений: 11927
Регистрация: 22.12.2012

Excel 2016, 365

#10

09.11.2017 12:36:04

Цитата
aesp написал:
Нельзя получить список окон? — скажите «НЕЛЬЗЯ!»

Почему нельзя?

Можно.

Только вряд ли кто на форуме по Excel занимался подобными вопросами, а те, кто ими занимается, они вряд ли ходят на форумы по Excel. Задайте вопрос в соответствующей ветке

WIN API

 

The_Prist

Пользователь

Сообщений: 15487
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

#11

09.11.2017 12:44:20

Цитата
aesp написал:
где список увидеть?

а где ответ на этот вопрос?

Цитата
The_Prist написал:
Получили список окон. Дальше что с ним делать?

Ответа не получил, поэтому вывел там, где удобно мне — в окно Immediate(Ctrl + G из редактора VBA).

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

 

aesp

Пользователь

Сообщений: 147
Регистрация: 09.03.2015

#12

09.11.2017 13:01:22

Цитата
The_Prist написал:
Получили список окон. Дальше что с ним делать?

— Увижу (наверное ) нужное наименование, подставлю в конструкцию из сообщения #3 и получу конкретный номер (hwnd) окна.. Как вывести список поверх всех окон?

 

The_Prist

Пользователь

Сообщений: 15487
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

#13

09.11.2017 13:11:21

Цитата
aesp написал:
Как вывести список поверх всех окон?

Поверх каких окон? Список вроде получили. А где же обещанное:

Цитата
aesp написал:
Увижу результат, смогу «прикрутить»

Список выводите куда хотите: хоть на форму, хоть в блокнот, хоть на лету чего-то там определяйте. Я целей Ваших не знаю, ответов на вопросы получаем тоже минимум. Поэтому дерзайте! Все, что необходимо для работы с открытыми окнами, вроде есть.
За вывод каждого названия отвечает строка:

Код
Debug.Print Trim(s)

мониторьте, сверяйте, ищите. И начните уже VBA изучать. Раз в API полезли, уж работу по пошаговой отладке кодов должны знать.

Изменено: The_Prist09.11.2017 13:14:45

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

 

aesp

Пользователь

Сообщений: 147
Регистрация: 09.03.2015

The_Prist, не сердитесь так! Всё на свете изучить не получается!
Я Вам очень признателен, Вы здорово мне помогли! Я получил, что искал. Благодарю!

 

The_Prist

Пользователь

Сообщений: 15487
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

#15

09.11.2017 13:43:52

Цитата
aesp написал:
не сердитесь так

я не сержусь. Но и не призываю учить все. Но отладку кодов обязан уметь делать каждый, кто лезет в программирование. Без этого никак. Может как-то поможет быстрее понять это:

Отлов ошибок и отладка кода VBA

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

 

abduvs77

Пользователь

Сообщений: 315
Регистрация: 16.06.2012

Офис-2013, Win.7 max

#16

09.11.2017 20:47:00

Цитата
The_Prist написал:
Отлов ошибок и отладка кода VBA

Спасибо Вам уважаемый The_Prist, Многому научился.

 

Мультипликатор

Пользователь

Сообщений: 331
Регистрация: 28.07.2009

#17

01.08.2019 10:51:16

Добрый день.
Скажите, пожалуйста, а как в указанном в посте #5 коде получить ссылку окна, ведь, чтобы дальше работать с полученным окном нужна ссылка.
Заменил в коде

Код
    If lw > 0 Then       
        Debug.Print Trim(s)
    End If

под свои нужды для поиска ИЕ, чтобы дальше работать с ними:

Код
       If lw > 0 Then
            If Trim(s) Like "*Windows Internet Explorer*" Then
                MsgBox Trim(s) 'Открытые окна
            End If
        End If

Но выдает имена окон. А как дальше получить доступ к ИЕ?
Обычно я получаю доступ к ИЕ так:

Код
        On Error Resume Next
        Set IE = CreateObject("InternetExplorer.Application")
        IE.Visible = True 'False '
        URL = "https://xxxxxxxxxxxt"
        IE.Navigate (URL): Do Until IE.ReadyState = 4: DoEvents: Loop

А дальше уже делаю что мне необходимо.
Для получения такого доступа мне нужна ссылка открытого окна. Как ее получить в указанном коде?
Или, для указанного кода можно получить доступ по другому?

Изменено: Мультипликатор01.08.2019 11:50:33

 

Спасибо, Игорь. Но не работает почему-то.
Библиотеку Microsoft Internet Controls подключил.
Debug.Print заменил на Msgbox
Показывает адреса двух открытых папок Проводника, хотя открыто было три папки, а ИнтернетЭксплорер открытый не нашел…
Так что не работает…

 

Игорь

Пользователь

Сообщений: 3695
Регистрация: 23.12.2012

А вы уверены, что у вас открыт именно Internet Explorer, а не Microsoft Edge?
Мой код проверен на множестве компов, всё везде работает
(а то, что папки проводника тоже отображаются, — так и должно быть)

 

Мультипликатор

Пользователь

Сообщений: 331
Регистрация: 28.07.2009

#21

02.08.2019 09:43:37

Цитата
Игорь написал:
А вы уверены, что у вас открыт именно Internet Explorer, а не Microsoft Edge?

Да, Игорь, абсолютно уверен. Макросами я работаю только с Internet Explorer. Из браузеров на компе установлен только Хром.
И еще я вспомнил, что я уже находил ваш код где-то полгода назад и он также показывал только Папки проводника, поэтому я его «забраковал».
Но тогда я отказался от этой идеи — искать открытые папки. И вот натолкнулся на код, который привел

The_Prist

.
Он работает, все имена выдает, но мне нужно работать с полученным окном дальше, т.е. читать, вносить, сохранять и т.д.
Для этого я должен как-то к нему обратиться, чтобы найти таблицы, input’ы, кнопки.
А вот этого я не знаю как сделать.  

 

Мультипликатор

Пользователь

Сообщений: 331
Регистрация: 28.07.2009

#22

02.08.2019 10:43:48

Цитата
Игорь написал:
Мой код проверен на множестве компов, всё везде работает

Игорь, прошу прощения.
Все работает, просто нужно было перезагрузить комп.
Видать, что-то глюкануло на компе.
Спасибо большое.

 

Мультипликатор

Пользователь

Сообщений: 331
Регистрация: 28.07.2009

#23

02.08.2019 13:40:00

Цитата
Мультипликатор написал:
Все работает, просто нужно было перезагрузить комп.Видать, что-то глюкануло на компе.

Нет, Игорь, что-то тут не так. Я подставил в код вместо URL$ = «*excelvba.ru*» URL$ = «*.ru*». После перезагрузки один раз сработало и я поспешил извиниться.
Но последующие разы снова стало все повторяться. Я не знаю, в чем может быть дело. Может быть, что-то не обнулено, хотя не вижу что. И опять стали появляться адреса открытых папок Проводника. После перезагрузки компа код четко выдал мне именно все открытые вкладки ИЕ, окон проводника не было.
А теперь снова.

 

Мультипликатор

Пользователь

Сообщений: 331
Регистрация: 28.07.2009

#24

02.08.2019 14:59:45

Прилагаю файл, в котором и сам макрос и результаты его работы выведены на лист, а также скриншот панели задач вставил прямо в файл Екселя.
По нему видно, что у меня открыто три окна ИЕ и семь окон проводника.
Однако результат: окон ИЕ не найдено, а окон проводника только шесть.
В чем же проблема? Мне кажется, что использование кода каким-то образом оставляет какие-то следы и повторное использование макроса приводит к ошибкам, но они не выявляются VBA. Этот же код не может быть одноразовым…
Что не так?

Прикрепленные файлы

  • Переборка всех открытых окон на компе-1.xlsm (103.01 КБ)



  • #2

Code:

Sub Main()
  Dim a, i&, fn$, prefix$
  ReDim a(1 To Workbooks.Count)
  
  prefix = "report to excel."
  For i = 1 To Workbooks.Count
    a(i) = Workbooks(i).Name
    If Left(a(i), Len(prefix)) = prefix Then fn = a(i)
  Next i
  MsgBox Join(a, vbLf)
  If fn <> "" Then MsgBox fn
End Sub



  • #3

Code:

Sub t()
Dim i As Long, msg As String
For i = 1 To Workbooks.Count
    msg = msg & Workbooks(i).Name & vbLf
Next
MsgBox msg
End Sub

Last edited:



  • #4

hi

I am after a macro to run that will display a list of all open workbooks.

or

I am after a macro to find a workbook that says «report to excel.##################» but instead of ## it is a sequence of numbers that can change and I don’t know what the pattern is (as in it is part of another system, it is something to do with date/time report number??» but the text before the dot is always the same.

I have below, to list all visible worksheets, but is there something similar I can use to list all open workbooks
Dim ws As Worksheet, ws1 As Worksheet
Set ws1 = Sheets(«Set up»)
i = 2
ws1.Columns(4).Insert
For Each ws In ThisWorkbook.Worksheets
If ws.Visible = xlSheetVisible Then
ws1.Cells(i, 1) = ws.Name
i = i + 1

End If
Next ws

thanks for any help you can give

sorry I must have not been very clear, I am after it to list the workbooks open, the above replies display the open workbooks in a msgbox (which is great but not what I am after)
I have this as below
Dim wb As Workbook, wb1 As Worksheet
Set wb1 = Sheets(«Sheet1»)
i = 2
wb1.Columns(4).Insert
For Each wb In Application.Workbooks
If wb.WorkbookOpen = wb.WorkbookOpen Then
wb1.Cells(i, 1) = wb.Name
i = i + 1

End If
Next wb
End Sub
but when I get to the if statement
If wb.WorkbookOpen = wb.WorkbookOpen Then
I get a debug, once I run past it, it does what I am after but if I have 5 workbooks open I need to run past it 5 times, is there a way to run past without the debug

Last edited:



  • #5

sorry I just add «on error resume next» and that seems to work

ok so is it possible to change it so that if I give it a list of workbooks that could possible be open it would run a macro base on that,

for example
if workbook name is «report to excel 1» then call Macro1
if workbook name is «report to excel 2» then call macro2
etc etc

but because the «report to excel 1» is called «report to excel 1.##(18 random numbers)» then how do I get it to work with that intial title of «report to excel 1» and call the macro???



  • #6

I think this might do what you want

Code:

Sub ListOpenWorkbooks()
    Dim wb As Workbook
    Dim i As Long
    
    With Sheet1.Range("A:A")
        .ClearContents
        i = 0
        For Each wb In Application.Workbooks
            If wb.Windows(1).Visible Then
                i = i + 1
                Cells(i, 1).Value = wb.Name
            End If
        Next wb
    End With
End Sub



  • #7

yes thank you!!
that’s prefect!!

the one I had does the same thing as yours, thanks again for you help, I think for my number problem I will use a formula to find the dot and just show the text before the dot and do it that way, make it a bit easier on myself



  • #8

I’m a little late. This code will get the names of any open workbooks that contains a partial specified text and set the specified workbook to a variable.

My experience has been that some users might have several workbooks open which will match the partial text in their workbook names. So this code will first determine if there are zero, one, or more than one workbooks that match the partial text.

If there are no matching workbooks then the user is notified to please open the desired workbook and the script ends.

If there is only 1 matching workbook with the specified partial text in its name then it will immediately set a variable to that open workbook.

If there are more than one open workbooks matching the specified partial text in its name then a dynamic array of workbook names will be created and presented in a userform, which you will need to create. See below for the elements of the userform which is named «Choose_Open_Workbook» in the following code.

VBA Code:

'    Public Variable Required to be passed from userform
Public workbook_To_Analyze As String    '    Name of Open Workbook to Analyze


Sub get_Name_of_Open_Workbook_To_Analyze()
'   Make Array of any or all open workbooks whose name includes
'   particular partial text ie, "ABC23"
'
'   If only one open wb matches specified partial text then
'   it will go to the desired code by the "Else" command below
'
'   Sometimesx the user may have more than one file open with the specified text
'   If more than one open workbooks match specified text then
'   place the wb names into an array of names and display them in a userform
'   to allow user to pick which file to manipulate.
'   This requires a user formn with a listbox1, a cancel command button, and a select command Button
'   Once the user selects a file then goto desired code with that specified file
'
'   If no files are found tht math the specified text then display an
'   error message reminding user to open the desired workbook before
'   running this code

    Dim i As Long, myArray() As Variant, myArrayCounter As Long, ABC23_WB As Workbook
   
    myArrayCounter = 0
   
   
    For i = 1 To Workbooks.Count
        If InStr(1, Workbooks(i).Name, "ABC23") > 0 Then
            myArrayCounter = myArrayCounter + 1
            ReDim Preserve myArray(1 To myArrayCounter)
            myArray(myArrayCounter) = Workbooks(i).Name
        End If
    Next
   
    If myArrayCounter = 0 Then
        MsgBox "Please Open Desired ABC23 File" & vbNewLine & "    before running this code."
        Exit Sub
    End If
   
    If myArrayCounter > 1 Then
        Choose_Open_Workbook.ListBox1.List = myArray
        Choose_Open_Workbook.Show
        If workbook_To_Analyze = "" Then '  User Cancelled userform
            Exit Sub
        End If
    Else  ' This means only one open workbook matches the partial desired text
        workbook_To_Analyze = myArray(1)
    End If
   
   
    '   The code to get data from main ABC23 workbook goes here

    Set ABC23_WB = Workbooks(workbook_To_Analyze)
   
    Debug.Print ABC23_WB.Sheets(1).Range("A3").Value
   
    '    Place whatever code you need here to manipulate the wb ABC23_WB
   
       
End Sub

.
Following are the elements of the userform:

VBA Code:

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} Choose_Open_Workbook
   Caption         =   "Please Select Which File to Analyze"
   ClientHeight    =   4725
   ClientLeft      =   120
   ClientTop       =   465
   ClientWidth     =   6870
   OleObjectBlob   =   "Choose_Open_Workbook.frx":0000
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "Choose_Open_Workbook"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub CommandButton1_Click()
workbook_To_Analyze = ""
Unload Me
End Sub

Private Sub CommandButton2_Click()
'   Public variable "workbook_To_Analyze" will contain correct workbook name
workbook_To_Analyze = ListBox1.Value
Unload Me
End Sub

VBA List all Open Workbooks in Excel. It helps to know all open workbooks name. It is easy to handle and shift between workbooks. We have an option to open multiple workbooks in MS Office Excel. Let us see in the following tutorial how to list open Workbooks in Excel VBA.

Here is the following syntax to List all Open Workbooks in Excel VBA.

For Each Workbook in Application.Workbooks
      Statements...
Next

Where Workbook: It represents Workbook object which is part of workbooks collection.

VBA Code to List all Workbooks in Excel VBA

Let us see the following example macro to List all Open Workbooks in Excel VBA

'VBA List Open Workbooks in Excel
Sub VBA_List_All_Open_Workbooks()
    
    'Variable declaration
    Dim xWorkbook As Workbook
    Dim sWorkbookName As String
    Dim iCount As Integer
    
    'Intialise value to a variable
    iCount = 2
    
    Sheets("WB_Names").Range("A1") = "Names of Available Workbooks"
    
    'Loop through all workbooks
    For Each xWorkbook In Application.Workbooks
        Sheets("WB_Names").Range("A" & iCount) = xWorkbook.Name & vbCrLf
        
        'Increase value
        iCount = iCount + 1
    Next

End Sub

Instructions to Run VBA Macro Code or Procedure:

You can refer the following link for the step by step instructions.

Instructions to run VBA Macro Code

Other Useful Resources:

Click on the following links of the useful resources. These helps to learn and gain more knowledge.

VBA Tutorial VBA Functions List VBA Arrays in Excel Blog

VBA Editor Keyboard Shortcut Keys List VBA Interview Questions & Answers

Option Explicit

Public Declare Function FindWindow Lib «user32» Alias «FindWindowA» (ByVal _

                        lpClassName As String, ByVal lpWindowName As String) As Long

Public Declare Function GetWindow Lib «user32» (ByVal hwnd As Long, ByVal wCmd As Long) As Long

Public Declare Function GetWindowText Lib «user32» Alias «GetWindowTextA» (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Public Declare Function GetWindowTextLength Lib «user32» Alias «GetWindowTextLengthA» (ByVal hwnd As Long) As Long

Public Const GW_HWNDFIRST = 0

Public Const GW_HWNDNEXT = 2

Sub GetTaskList()

    Dim lw As Long, s As String, CurrWnd As Long

    CurrWnd = GetWindow(Application.hwnd, GW_HWNDFIRST)

    Do While CurrWnd <> 0

        lw = GetWindowTextLength(CurrWnd)

        s = Space(lw + 1)

        lw = GetWindowText(CurrWnd, s, lw + 1)

        If lw > 0 Then

            Debug.Print Trim(s)

        End If

        CurrWnd = GetWindow(CurrWnd, GW_HWNDNEXT)

        DoEvents

    Loop

End Sub

Sub PerebratIE()

Dim IE As SHDocVw.InternetExplorer, URL$

URL$ = «*.ru*» ‘

Set IE = GetRunningIE(URL$)

If IE Is Nothing Then

MsgBox «Вкладка не найдена»

Else

MsgBox IE.Document.DocumentElement.outerHTML, vbInformation, «Исходный код страницы»

End If

End Sub

Function GetRunningIE(ByVal URL$, Optional ActivateWindow As Boolean = True) As SHDocVw.InternetExplorer

‘ подключается к браузеру IE, в котором открыта вкладка со страницей URL$

On Error Resume Next

Dim w As WebBrowser, oShellWind As New ShellWindows

‘ MsgBox URL$

For Each w In oShellWind

ПослСтр = Cells(Rows.Count, 1).End(xlUp).Row

Cells(ПослСтр + 1, 1) = w.LocationURL

If w.LocationURL Like URL$ Then

MsgBox w.LocationURL

‘If ActivateWindow Then

‘ ShowWindow w.Hwnd, 5

‘ SetForegroundWindow w.Hwnd

‘End If

Set GetRunningIE = w

MsgBox «Подключение выполнено к IE со ссылкой», w.LocationURL

‘ Exit For

End If

Next

Set oShellWind = Nothing

End Function

‘Public Declare Function FindWindow Lib «user32» Alias «FindWindowA» (ByVal _

‘ lpClassName As String, ByVal lpWindowName As String) As Long

‘Public Declare Function GetWindow Lib «user32» (ByVal hwnd As Long, ByVal wCmd As Long) As Long

‘Public Declare Function GetWindowText Lib «user32» Alias «GetWindowTextA» (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

‘Public Declare Function GetWindowTextLength Lib «user32» Alias «GetWindowTextLengthA» (ByVal hwnd As Long) As Long

‘Public Const GW_HWNDFIRST = 0

‘Public Const GW_HWNDNEXT = 2

‘Sub GetTaskList()

»Перебирает все открытое, при нормальной работе было открыто 241 окно

‘ Dim lw As Long, s As String, CurrWnd As Long

‘ CurrWnd = GetWindow(Application.hwnd, GW_HWNDFIRST)

‘ СчетчикОткрытыхОкон = 0

‘ Do While CurrWnd <> 0

‘ lw = GetWindowTextLength(CurrWnd)

‘ s = Space(lw + 1)

‘ lw = GetWindowText(CurrWnd, s, lw + 1)

‘ If lw > 0 Then

‘ If Trim(s) Like «*Windows Internet Explorer*» Then

‘ СчетчикОткрытыхОкон = СчетчикОткрытыхОкон + 1

‘ ПослСтр = Cells(Rows.Count, 1).End(xlUp).Row

‘ Cells(ПослСтр + 1, 1) = Trim(s)

‘ MsgBox Trim(s) ‘Открытые окна

‘ End If

‘ End If

‘ CurrWnd = GetWindow(CurrWnd, GW_HWNDNEXT)

‘ DoEvents

‘ Loop

‘ MsgBox СчетчикОткрытыхОкон

‘End Sub

‘Sub hgjg()

‘Application.DisplayAlerts = False

‘ф = «https://docs.google.com/spreadsheets/d/1thxKiDJ3Mmv1y-8XzX3YFSX_ZldYOjWWb1Gg0IasnGU/export»

‘Hyperlinks(ф).Follow

‘MsgBox «Открылось»

‘End Sub

‘Sub ОткрываемЧерезХромСсылку()

‘aaaa = «https://docs.google.com/spreadsheets/d/1thxKiDJ3Mmv1y-8XzX3YFSX_ZldYOjWWb1Gg0IasnGU/export»

‘Shell («C:\Program Files (x86)\Google\Chrome\Application\chrome.exe» & » » & aaaa)

‘End Sub

Понравилась статья? Поделить с друзьями:
0 0 голоса
Рейтинг статьи
Подписаться
Уведомить о
guest

0 комментариев
Старые
Новые Популярные
Межтекстовые Отзывы
Посмотреть все комментарии
  • Как включить режим vga на windows xp
  • Централизованное хранение логов windows
  • Canoscan lide 60 драйвер для windows 10 x64
  • Как задать размер окна windows
  • Замена иконки кнопки пуск в windows 10