Переход в браузер по кнопке.

Страница 1 из 1 1
Модератор форума: китин, _Boroda_, DrMini

Переход в браузер по кнопке. (Макросы/Sub)

Mark1976

Дата: Пятница, 27.06.2025, 08:22 | Сообщение № 1

Группа: Проверенные

Ранг: Ветеран

Сообщений: 815

Репутация: 3 ±

Замечаний: 0% ±

Excel 2010, 2013

Здравствуйте. Необходимо по кнопке сделать переход в браузер (хром) на сайт реестра лекарственных препаратов. Адрес сайта в ячейке D1. Заранее спасибо.

К сообщению приложен файл: avtomatizacija_grls.xlsx (10.0 Kb)

Сообщение отредактировал Mark1976 - Пятница, 27.06.2025, 08:37

Ответить

bigor

Дата: Пятница, 27.06.2025, 08:40 | Сообщение № 2

Группа: Проверенные

Ранг: Старожил

Сообщений: 1374

Репутация: 269 ±

Замечаний: 0% ±

нет

Mark1976, кнопка обязяательна? в D3

Код

=HYPERLINK(CONCATENATE(A1;B1;C1);"тыц")

и жмакайте по ссылке

Ответить

Mark1976

Дата: Пятница, 27.06.2025, 08:43 | Сообщение № 3

Группа: Проверенные

Ранг: Ветеран

Сообщений: 815

Репутация: 3 ±

Замечаний: 0% ±

Excel 2010, 2013

bigor, здравствуйте. Ошибка: не удается открыть.

Ответить

bigor

Дата: Пятница, 27.06.2025, 09:14 | Сообщение № 4

Группа: Проверенные

Ранг: Старожил

Сообщений: 1374

Репутация: 269 ±

Замечаний: 0% ±

нет

Цитата Mark1976, 27.06.2025 в 08:43, в сообщении № 3 (

)

не удается открыть

да, excel и у меня пытается сам открыть ссылку, но не может пролезть через прокси. Тогда макросом, рисуете кнопку и вешаете на нее макрос
[vba]

Код

Sub linl()
Shell ActiveSheet.Range("d1").Value, vbNormalFocus
End Sub

[/vba]
в ячейку А2 прописываем полный путь к Хрому, в D1 формула

Код

=СЦЕПИТЬ("""";A2;"""""";A1;B1;C1;"""""""")

К сообщению приложен файл: avtomatizacija_grls.xlsm (13.5 Kb)

Сообщение отредактировал bigor - Пятница, 27.06.2025, 09:15

Ответить

Mark1976

Дата: Пятница, 27.06.2025, 09:40 | Сообщение № 5

Группа: Проверенные

Ранг: Ветеран

Сообщений: 815

Репутация: 3 ±

Замечаний: 0% ±

Excel 2010, 2013

bigor, работает, но через доп.сообщение.

К сообщению приложен файл: 4086802.jpg (19.9 Kb)

Ответить

bigor

Дата: Пятница, 27.06.2025, 10:30 | Сообщение № 6

Группа: Проверенные

Ранг: Старожил

Сообщений: 1374

Репутация: 269 ±

Замечаний: 0% ±

нет

Цитата Mark1976, 27.06.2025 в 09:40, в сообщении № 5 (

)

доп.сообщение.

удалите или закомментируйте вторую строку в макросе, которая на Msgbox начинается

Ответить

Mark1976

Дата: Воскресенье, 29.06.2025, 12:01 | Сообщение № 7

Группа: Проверенные

Ранг: Ветеран

Сообщений: 815

Репутация: 3 ±

Замечаний: 0% ±

Excel 2010, 2013

bigor, здравствуйте. Эту Shell ActiveSheet.Range("d1").Value, vbNormalFocus? Тогда макрос не будет работать. В нем всего 3 строки.

Сообщение отредактировал Mark1976 - Воскресенье, 29.06.2025, 12:02

Ответить

MikeVol

Дата: Воскресенье, 29.06.2025, 15:11 | Сообщение № 8

Группа: Проверенные

Ранг: Обитатель

Сообщений: 444

Репутация: 106 ±

Замечаний: 0% ±

MSO LTSC 2021 EN

Mark1976, Опять же из той серии что в соседней теме, но чуть модифицировано. [vba]

Код

Option Explicit

Sub ЗапуститьEdgeПерейтиПоСсылке()
    Dim shell As Object

    On Error GoTo Ошибка

    ' Получаем путь к Edge из реестра
    Dim edgePath As String
    edgePath = CreateObject("WScript.Shell").RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\msedge.exe\")

    ' Получаем ссылку из Excel
    Dim eLink As String
    eLink = Trim(ThisWorkbook.Worksheets("Лист1").Range("D1").Value)

    If Len(eLink) = 0 Then
        MsgBox "Ссылка не указана в ячейке D1.", vbExclamation
        Exit Sub
    End If

    ' Добавляем кавычки, если есть пробелы
    If InStr(eLink, " ") > 0 Then
        eLink = """" & eLink & """"
    End If

    Set shell = CreateObject("WScript.Shell")
    shell.Run """" & edgePath & """ " & eLink, 1, False

    Exit Sub

Ошибка:
    MsgBox "Ошибка при запуске Edge: " & Err.Description, vbCritical
End Sub

[/vba]Тут мы будем использовать приложение Microsoft Edge (интернет браузер) с переходом по указанной ссылке в ячейке D1. Можете другой интернет браузер использовать сделав небольшие корривтировки в коде в строке: =CreateObject("WScript.Shell").RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\msedge.exe\")Удачи.

Ученик.
Одесса - Украина

Ответить

bigorq

Дата: Воскресенье, 29.06.2025, 16:33 | Сообщение № 9

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 205

Репутация: 47 ±

Замечаний: 0% ±

Нет

Mark1976, сообщение выскакивает, если вы запускаете макрос а приложенном мной файле, я там не удалил строку с msg box. В посте 4 макрос уже без этой строки