Поиск в Google значений из ячеек листа Excel

Скажите пожалуйста, что нужно сделать в 2024 году для MO 2019, что бы макрос заработал?
1. Ни при каких условиях автоматически, по правому клику мыши не появляется контекстное меню
2. Если запустить макрос контекстного меню из списка, то контекстное меню начинает появляться, но...
3. Далеко не на всех листах книги! И понять принцип, по какому на одном листе появляется, а на каком то нет - совершенно невозможно.
4. Даже если, выбрать поиск из ячейки на листе, на котором контекстное меню появилось, то поисковый запрос обрубается ровно до первой кавычки в тексте.
Вот так выглядит контекстное меню на одном листе (отсутствует) https://disk.yandex.ru/i/RdKAfqyOh2Dtyw
Вот так на соседнем листе (выбраны одни и те же данные) https://disk.yandex.ru/i/5O1jinvzVl4sbw
Повторюсь, контекстное меню запустилось только вручную.
Понимаю, макрос был написан давно, но решение очень изящное и удобное и все интернеты ведут сюда с подобной задачей.
PS: Да, прилагаемый файл работает идеально и контекстное меню автоматом и на всех листах (но если добавить кавычки внутрь текста то в поиск подставляется текст только до кавычек)

А если в браузере по умолчанию нужно запустить инкогнито, куда команду дописать? Во втором варианте получилось.

Case "Mozilla Firefox"
Path$ = """" & Environ("ProgramFiles") & "\Mozilla Firefox\firefox.exe" & """ -private-window "

Спасибо большое!

А как сделать чтобы открывающийся лист браузера был инкогнито без формирования кэша?

Всем доброго дня. Выкладываю код, чтобы запускать макрос из надстройки или кнопкой (макрос на создание меню убран).

Sub SearchValuesInWeb()
Dim Link$
' Макрос открывает в выбранном браузере результаты поиска значений из ячеек
' поиск производится в Google

If Err Then Exit Sub ' запуск не из контекстного меню

maxCellsCount = 10 ' больше 20 ячеек - отказываемся от запуска поиска

Dim coll As New Collection
' берем только непустые уникальные значения из выделенного диапазона ячеек
Dim ra As Range: Set ra = Intersect(Selection, ActiveSheet.UsedRange)
Arr = ra.Value: If ra.Cells.Count = 1 Then Arr = Array(ra(1))
For Each Item In Arr
If Len(Trim(Item)) Then coll.Add CStr(Trim(Item)), CStr(Trim(Item))
If coll.Count > maxCellsCount Then Exit For
Next

' если случайно запустить поиск тысячи значений - комп подвиснет надолго...
If coll.Count > maxCellsCount Then
msg = "Количество значений для поиска провысило ограничение в " & maxCellsCount & " ячеек!"
MsgBox msg, vbExclamation, "Слишком много значений - поиск отменяется"
Exit Sub
End If

' формируем путь к выбранному браузеру (в реестре нужную информацию выкопать сложно...)
' не факт, что быдет работать на всех компах (программы могли быть установлены в другие папки)
Path$ = """" & "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" & """"

' проверяем существование исполняемого файла браузера
Path2$ = Path$: If Dir(Split(Path$, Chr(34))(1), vbNormal) = "" Then Path2$ = ""

For Each Item In coll ' перебираем все уникальные значения ячеек
' формируем поисковую ссылку для Google
n = n + 1
Link = """" & "http://www.google.ru/search?hl=ru&newwindow=1&q=" & Item & """"
CreateObject("wscript.shell").Run Link
' после первой ссылки дожидаемся запуска браузера (1 секунду)
If n = 1 Then Application.Wait Now + 1 / 86400
Next
End Sub

Здравствуйте, а можно осуществить поиск не в Гугле, а на конкретном сайте?

Здравствуйте!
Скажите, а можно ли через макрос синхронизировать текущую дату по интернету.
Хочу задать ограничение на работу программы по текущей дате.
Сейчас код выглядит так:

Private Sub Workbook_Open()

If Date < 42005 Then

Else
Sheets("Лист1").Select
ActiveSheet.Cells(1, 1).Value = 0

End If

End Sub

где значение Cells(1, 1)прекращает действие программы.
Но это очень просто обойти-всего лишь меняем дату в календаре виндовс. Как быть?

Код не работает с некоторыми символами.

Если поиск ведется по тексту вида
текст1 | текст2
т.е. используя логический оператор ИЛИ

Подскажите чем это может быть связано? Даже если мы меняем символ | на %7с - все равно не хочет.

Спасибо большае вам за полезный ресурс.
Свою задачу решил, но я незнаю правильно ли технически она решена, но тем немение работаю на 100%

Sub CreateItemsInCellContextMenu()
On Error Resume Next
PopularBrowsers = Array("2gis maps", "Yandex maps", "Google maps", "Yandex", "Google")

Application.CommandBars("cell").Reset ' сброс контекстного меню ячеек
Application.CommandBars("cell").Controls(1).BeginGroup = True ' черточка над первым пунктом меню

' добавляем пункты в контекстное меню ячеек
With Application.CommandBars("cell").Controls.Add(10, , , 1)
.Caption = "Искать на ..."

' добавляем подпункты в меню
For Each browser In PopularBrowsers ' для каждого браузера - свой подпункт меню
With .Controls.Add(1, , , 1) ' добавляем пункт меню
.OnAction = "SearchValuesInWeb" ' назначаем кнопке макрос SearchValuesInWeb
.Caption = browser: .Tag = browser ' в свойстве TAG запоминаем название браузера
End With
Next
End With
End Sub

Sub SearchValuesInWeb()
' Макрос открывает в выбранном браузере результаты поиска значений из ячеек
' поиск производится в Google

On Error Resume Next: Err.Clear
browser$ = Application.CommandBars.ActionControl.Tag ' читаем параметр из свойства TAG
If Err Then Exit Sub ' запуск не из контекстного меню

maxCellsCount = 20 ' больше 20 ячеек - отказываемся от запуска поиска

Dim coll As New Collection
' берем только непустые уникальные значения из выделенного диапазона ячеек
Dim ra As Range: Set ra = Intersect(Selection, ActiveSheet.UsedRange)
arr = ra.Value: If ra.Cells.Count = 1 Then arr = Array(ra(1))
For Each Item In arr
If Len(Trim(Item)) Then coll.Add CStr(Trim(Item)), CStr(Trim(Item))
If coll.Count > maxCellsCount Then Exit For
Next

' если случайно запустить поиск тысячи значений - комп подвиснет надолго...
If coll.Count > maxCellsCount Then
msg = "Количество значений для поиска провысило ограничение в " & maxCellsCount & " ячеек!"
MsgBox msg, vbExclamation, "Слишком много значений - поиск отменяется"
Exit Sub
End If

' формируем путь к выбранному браузеру (в реестре нужную информацию выкопать сложно...)
' не факт, что быдет работать на всех компах (программы могли быть установлены в другие папки)
Select Case browser$ ' "Internet Explorer", "Mozilla Firefox", "Opera", "Google Chrome"
Case "2gis maps"
For Each Item In coll ' перебираем все уникальные значения ячеек
' формируем поисковую ссылку для Google
link$ = """" & "http://2gis.ru/#!/odessa/center/30.711727%2C46.461917/zoom/11/state/firms/what/" & Item & "/action/search/page/1/sort/relevance/rpage/1/ppage/1" & """"
' открываем ссылку в браузере "по-умолчанию"
CreateObject("wscript.shell").Run link$
Next
Case "Yandex maps"
For Each Item In coll ' перебираем все уникальные значения ячеек
' формируем поисковую ссылку для Google
link$ = """" & "http://maps.yandex.ua/?text=" & Item & """"
' открываем ссылку в браузере "по-умолчанию"
CreateObject("wscript.shell").Run link$
Next
Case "Google maps"
For Each Item In coll ' перебираем все уникальные значения ячеек
' формируем поисковую ссылку для Google
link$ = """" & "http://maps.google.com/?q=" & Item & """"
' открываем ссылку в браузере "по-умолчанию"
CreateObject("wscript.shell").Run link$
Next
Case "Yandex"
For Each Item In coll ' перебираем все уникальные значения ячеек
' формируем поисковую ссылку для Google
link$ = """" & "http://yandex.ru/yandsearch?text=" & Item & """"
' открываем ссылку в браузере "по-умолчанию"
CreateObject("wscript.shell").Run link$
Next
Case "Google"
For Each Item In coll ' перебираем все уникальные значения ячеек
' формируем поисковую ссылку для Google
link$ = """" & "http://www.google.ru/search?hl=ru&newwindow=1&q=" & Item & """"
' открываем ссылку в браузере "по-умолчанию"
CreateObject("wscript.shell").Run link$
Next
End Select
End Sub

Превосходно, этому тоже найдется 100 % применение, спасибо Вам.
Но я не правильно выразился, уточню. Нужно чтобы поиск осуществлялся для каждой поисковой системы отдельно, то есть нужно искать в гугле то жмем кнопку поиск в гугле, нужно для яндекса тогда жмем кнопку поиск в яндексе.
И тоже важный факт, желательно чтобы эти кнопки поисковых систем скрывались в дополнительном выпадающем списке, то есть там где сейчас перечень браузеров, так как список поисковых систем будет большой, поэтому чтобы не увеличивать контекстное меню эти списки нужно прятать.
Спасибо

Подскажите пожалуйста, как сделать чтобы данный макрос открывал не в разных браузерах а в разных поисковых системах с помощью браузера по умолчанию ?

Знаете, ничего не помогало.
Но методом научного тыка определилось решение - надо перевести страницу в режим "страничный" (когда синими полосами выделены границы страниц) и тогда меню появляется.
Я ума не приложу, в связи с чем связано такое поведение макроса, но именно так заработало.

Хотя даже если путь к папке Program Files неверный, то контекстное меню ведь все равно должно появляться? Оно ведь не зависит от пути к Program Files.

Совершенно ничего не происходит. Как будто макроса нет.
Путь к папке Program Files завтра проверю, может и в этом дело.

Добрый вечер.
Отличный макрос.
Но на одном ПК работает, а на другом нет (совсем никаких признаков жизни, даже ошибку не выдает).
Разрешение на макросы максимальные. Офис и там и там 2010. Винда и там и там 7.
Не подскажите, в чем возможная причина?

Спасибо.
Идея с формированием меню при нажатии ПКМ - супер!
Переделал под свою задачу, все работает отлично!

Отличный макрос! Очень помогает при поиске данных в определенной базе из Excel.
Заменил адрес поисковой ссылки и все... Работает!
Спасибо разработчикам!

«Подсвечивать результат» – это сделать так, чтобы пользователь в большом Вордовском документе легко увидел найденное вхождение. Например желтой заливкой выделить.

А можно искать подобным образом в Вордовском файле и подсвечивать результат?

на двух компьютерах excel 2007 копирую код из module1 и из ЭтаКнига в Personal.xlsb ,-безрезультатно.а если скопировать в другую книгу,то в ней все работает

я про небольшие изменения в код и спрашиваю

Здравствуйте!подскажите пожалуйста,как сделать,чтобы поиск можно было запустить из любой книги?