Здравствуйте. Помогите пожалуйста создать кнопку, которая бы работала следующим образом: новый файл - появляется диалоговое окно с просьбой ввести линк. Линк сохраняется автоматически и при всех последующих открытиях файла, при нажатие на кнопку переводит по ссылке. Уже без диалогового окна. В принципе алгоритм в два шага, но поскольку синтаксиса я не знаю, не могу обратиться к гиперссылке. Ну и вообще меня терзают смутные сомнения, что это гиперссылка, по-моему получился текст!
Здравствуйте. Помогите пожалуйста создать кнопку, которая бы работала следующим образом: новый файл - появляется диалоговое окно с просьбой ввести линк. Линк сохраняется автоматически и при всех последующих открытиях файла, при нажатие на кнопку переводит по ссылке. Уже без диалогового окна. В принципе алгоритм в два шага, но поскольку синтаксиса я не знаю, не могу обратиться к гиперссылке. Ну и вообще меня терзают смутные сомнения, что это гиперссылка, по-моему получился текст!Tunka-s
Привет! Ваша ссылка по простому не хочет открываться, поэтому [vba]
Код
Private Sub Image1_Click() Dim strInput As String If IsEmpty(Worksheets("Drawing").Cells(1, 1)) = True Then strInput = InputBox("DRAWING", "Incert Link") Worksheets("Drawing").Cells(1, 1) = strInput Else Call WebPageText(Worksheets("Drawing").Cells(1, 1)) End If End Sub
Function WebPageText(ByVal sURL As String) As String 'http://excelvba.ru/code/GetWebPageText Set ie = CreateObject("InternetExplorer.Application"): ' загружаем браузер Internet Explorer ie.Navigate sURL ' загружаем сайт While ie.busy Or (ie.readyState <> 4) DoEvents Wend ' ждем, пока загрузится страница ie.Visible = 1 Stop ie.Quit: Set ie = Nothing ' закрываем браузер End Function
[/vba]
Привет! Ваша ссылка по простому не хочет открываться, поэтому [vba]
Код
Private Sub Image1_Click() Dim strInput As String If IsEmpty(Worksheets("Drawing").Cells(1, 1)) = True Then strInput = InputBox("DRAWING", "Incert Link") Worksheets("Drawing").Cells(1, 1) = strInput Else Call WebPageText(Worksheets("Drawing").Cells(1, 1)) End If End Sub
Function WebPageText(ByVal sURL As String) As String 'http://excelvba.ru/code/GetWebPageText Set ie = CreateObject("InternetExplorer.Application"): ' загружаем браузер Internet Explorer ie.Navigate sURL ' загружаем сайт While ie.busy Or (ie.readyState <> 4) DoEvents Wend ' ждем, пока загрузится страница ie.Visible = 1 Stop ie.Quit: Set ie = Nothing ' закрываем браузер End Function
InExSu, Спасибо вам огромное! Я в пятницу надежду потеряла и не заглядывала сюда два дня. Все почти идеально работает, только когда вебстраницу закрываешь, выскакивает ошибка: the object invoked has disconnected from its clients
InExSu, Спасибо вам огромное! Я в пятницу надежду потеряла и не заглядывала сюда два дня. Все почти идеально работает, только когда вебстраницу закрываешь, выскакивает ошибка: the object invoked has disconnected from its clientsTunka-s
Попробовала разные варианты. С On Error Resume Next сообщения об ошибке нет, но все равно опять выскакивает код и СТОП подсвечен желтым. Я убрала последние две строки после ie.Visible = 1 и теперь все прекрасно работает. Спасибо вам тысячу раз!!!
Попробовала разные варианты. С On Error Resume Next сообщения об ошибке нет, но все равно опять выскакивает код и СТОП подсвечен желтым. Я убрала последние две строки после ie.Visible = 1 и теперь все прекрасно работает. Спасибо вам тысячу раз!!!Tunka-s