Страницы: 1
RSS
На сайте отправить адрес в поле поиска
 
Добрый день, просьба помочь с такой проблемой. Есть веб страница по адресу: http://map.mossvet.ru:51/#.
Необходимо по нажатию к за отнопки на форме (отправить адрес.xlsb) передать на вышеупомянутый сайт адрес из ячейки A1.
Необходимо обратиться к троеточию (клик по нему) в открывшемся поле передать данные из ячейки и сделать клик по одному из предложенных вариантов.
Суть такова: карта открывается всегда в центре, а надо чтобы при вводе улицы она открывалась в нужном районе.

Рисунки удалены - превышение допустимого размера вложения [МОДЕРАТОР]
 
Григорий Тимофеев, добрый.

А какой у вас браузер используется? VBA не работает с современными браузерами(исключаются всякие грабли), только Internet Explorer. Но там не работает выпадающий список адресов.
Вы бы написали, каков итог вам нужен кроме вставки в адресное поле.
 
Цитата
Oleg Boyaroff написал:
VBA не работает с современными браузерами
А Opera современный?
Код
Sub qqq()
    x = Shell("""C:\Program Files\Opera\launcher.exe""" & """http://www.planetaexcel.ru""", vbNormalNoFocus)
End Sub

 
Цитата
Юрий М написал: А Opera современный?
Цитата
Григорий Тимофеев написал: Необходимо обратиться к троеточию (клик по нему)
ТСу нужно кликать и вставлять в браузере :)  
 
Но Вы же утверждаете, что VBA  не работает. Почему у меня сработало? )
Згачит всё же умеет?
P.S. А вот с Мозиллой не хочет так...
Кстати, у Игоря на сайте есть статья по работе с разными браузерами.
 
по введенному адресу карта открывается на нужном месте - это и хотелось осуществить - по умолчанию центр стоит
Изменено: Тимофеев - 22.01.2021 11:56:53
 
браузер не принципиально какой будет использоваться. Сейчас по умолчанию Microsoft Edge у меня открывает
 
Доброго времени суток
для IE
Код
Sub Go_To_Site()
    Dim fn$
    Const BaseUrl$ = "http://map.mossvet.ru:51/"
    With CreateObject("internetexplorer.application")
        .navigate ""
        .document.parentWindow.execScript "document.write(encodeURI('" & [A1] & "'))", "JavaScript"
        GotoUrl .Application, BaseUrl & "AddressDetail.php?Address=" & .document.body.innertext
        fn = "(" & .document.body.querySelector("tr").onclick & ")(0)"
        GotoUrl .Application, BaseUrl
        .document.parentWindow.execScript fn, "JavaScript"
        .Visible = 1
    End With
End Sub
Sub GotoUrl(ByRef ie As Object, url$, Optional timeout% = 5)
    Dim t!
    ie.navigate url
    t = Timer
    Do
        DoEvents
        If Timer - t >= timeout Then
            MsgBox "Timeout!", 16
            Stop
        End If
    Loop Until ie.ReadyState = 4
End Sub
Изменено: Андрей Лящук - 03.09.2020 03:03:35
 
Андрей Лящук - Вы просто молодец большой !
а данный сеанс интернет эксплорер на весь экран как сделать сразу? По этому вопросу разобрался добавил в код:
.FullScreen = True

Возможно ли ориентацию карты сделать по инвентарному номеру?

во вложении скрин примера.
На карте красные полигоны штрихпунктир при нажатии левой кнопки мыши - вадает окно Объект освещение + Нажав на + выскакивает таблица данных с инвентарным номером. Допустим 32641
И собрать в ячейки А2:В2 и далее наименования и кол-ва окна инвентарки
Изменено: Тимофеев - 22.01.2021 11:57:58
 
Григорий Тимофеев, свои сообщения можно редактировать, а не создавать новое.
 
спасибо, научился редактировать
 
Цитата
Григорий Тимофеев написал:
Возможно ли ориентацию карты сделать по инвентарному номеру?
с этим вопроом вам надо обращаться к разработчикам карты
 
Добрый день
в посте 8 Андрей Лящук предложил решение позиционирования на карте сайта http://map.mossvet.ru:51/
Теперь на сайте добавлены логин и пароль при входе на данную страницу
Просьба подсказать какие строки нужно дописать в макрос чтобы логин и пароль ввести далее нажать кнопку вход и продолжить макрос поста 8 ?  
 
в поисковиках нашел несколько строк как в код дописать авторизацию - но видимо не туда вставил не работает. Подскажите что поправить
Код
Sub Go_To_Site()
    Dim fn$
    Const BaseUrl$ = "http://map.mossvet.ru:51/#"
    With CreateObject("internetexplorer.application")
        .navigate ""
        .Document.parentWindow.execScript "document.write(encodeURI('" & [BB4] & "'))", "JavaScript"
        GotoUrl .Application, BaseUrl & "AddressDetail.php?Address=" & .Document.body.innertext
        fn = "(" & .Document.body.querySelector("tr").onclick & ")(0)"
        GotoUrl .Application, BaseUrl
        .Document.parentWindow.execScript fn, "JavaScript"
        .Visible = 1
        End With
End Sub
Sub GotoUrl(ByRef ie As Object, url$, Optional timeout% = 5)
    Dim t!
    t = Timer
    Do
        DoEvents
        If Timer - t >= timeout Then
            MsgBox "Timeout!", 16
            Stop
        End If
    Loop Until ie.ReadyState = 4
    ie.Document.All("auth_name").Value = "***"
    ie.Document.All("auth_pass").Value = "***"
    ie.Document.All("submit").Click
End Sub
Изменено: Тимофеев - 22.01.2021 11:27:16
Страницы: 1
Наверх