У меня есть вопрос к экспертам. Как макросом установить гиперссылку на определенный диапазон по их тексту (в тексте указан просто адрес файла или папки) ? Срабатывание - при каждом пересчете таблицы.
Обычно в экселе делают формулу
Код
=ГИПЕРССЫЛКА(D35)
Но мне нужно макросом поставить как-то ссылку на этот адрес в виде текста. (Я думаю тут файл прилагать не нужно - просто обычный диапазон. Если макрос увидит какой-то текст - то при пересчете листа превратит этот текст в ссылку.)
Доброго времени суток.
У меня есть вопрос к экспертам. Как макросом установить гиперссылку на определенный диапазон по их тексту (в тексте указан просто адрес файла или папки) ? Срабатывание - при каждом пересчете таблицы.
Обычно в экселе делают формулу
Код
=ГИПЕРССЫЛКА(D35)
Но мне нужно макросом поставить как-то ссылку на этот адрес в виде текста. (Я думаю тут файл прилагать не нужно - просто обычный диапазон. Если макрос увидит какой-то текст - то при пересчете листа превратит этот текст в ссылку.)dmitrijaltman8
On Error Resume Next Set A = Columns(1).SpecialCells(xlCellTypeConstants) If Err = 0 Then Application.EnableEvents = False On Error GoTo 0 For Each Cell In A If Cell.Hyperlinks.Count = 0 Then adr = Cell Cell.ClearContents Cell.Hyperlinks.Add Anchor:=Cell, Address:=Cell, SubAddress:= _ adr, TextToDisplay:=adr End If Next Application.EnableEvents = False End If
[/vba]
[vba]
Код
On Error Resume Next Set A = Columns(1).SpecialCells(xlCellTypeConstants) If Err = 0 Then Application.EnableEvents = False On Error GoTo 0 For Each Cell In A If Cell.Hyperlinks.Count = 0 Then adr = Cell Cell.ClearContents Cell.Hyperlinks.Add Anchor:=Cell, Address:=Cell, SubAddress:= _ adr, TextToDisplay:=adr End If Next Application.EnableEvents = False End If
On Error Resume Next Set A = Columns(1).SpecialCells(xlCellTypeConstants) If Err = 0 Then Application.EnableEvents = False On Error GoTo 0 For Each Cell In [A48:B87] If Cell.Hyperlinks.Count = 0 Then adr = Cell Cell.ClearContents Cell.Hyperlinks.Add Anchor:=Cell, Address:=Cell, SubAddress:= _ adr, TextToDisplay:=adr End If Next Application.EnableEvents = False End If
End Sub
[/vba]
Выдает ошибку Runtime error call И не расставляет гиперссылки
bmv98rus, спасибо. Но почему-то не работает.
Вот я диапазон записал туда свой: [vba]
Код
Private Sub Worksheet_Calculate()
On Error Resume Next Set A = Columns(1).SpecialCells(xlCellTypeConstants) If Err = 0 Then Application.EnableEvents = False On Error GoTo 0 For Each Cell In [A48:B87] If Cell.Hyperlinks.Count = 0 Then adr = Cell Cell.ClearContents Cell.Hyperlinks.Add Anchor:=Cell, Address:=Cell, SubAddress:= _ adr, TextToDisplay:=adr End If Next Application.EnableEvents = False End If
End Sub
[/vba]
Выдает ошибку Runtime error call И не расставляет гиперссылкиdmitrijaltman8
Сообщение отредактировал dmitrijaltman8 - Четверг, 26.08.2021, 09:27
On Error Resume Next Set A = [A48:B87].SpecialCells(xlCellTypeConstants) If Err = 0 Then Application.EnableEvents = False On Error GoTo 0 For Each Cell In A If Cell.Hyperlinks.Count = 0 Then adr = Cell Cell.ClearContents Cell.Hyperlinks.Add Anchor:=Cell, Address:=Cell, SubAddress:= _ adr, TextToDisplay:=adr End If Next Application.EnableEvents = True End If
End Sub
[/vba]
[vba]
Код
Private Sub Worksheet_Calculate()
On Error Resume Next Set A = [A48:B87].SpecialCells(xlCellTypeConstants) If Err = 0 Then Application.EnableEvents = False On Error GoTo 0 For Each Cell In A If Cell.Hyperlinks.Count = 0 Then adr = Cell Cell.ClearContents Cell.Hyperlinks.Add Anchor:=Cell, Address:=Cell, SubAddress:= _ adr, TextToDisplay:=adr End If Next Application.EnableEvents = True End If
(Я думаю тут файл прилагать не нужно - просто обычный диапазон. Если макрос увидит какой-то текст - то при пересчете листа превратит этот текст в ссылку.)
какй-то текст в ссылку превращен? - да, задача выполнена.
dmitrijaltman8, это просто закономерный результат этого
(Я думаю тут файл прилагать не нужно - просто обычный диапазон. Если макрос увидит какой-то текст - то при пересчете листа превратит этот текст в ссылку.)
какй-то текст в ссылку превращен? - да, задача выполнена.bmv98rus
Замечательный Временно просто медведь , процентов на 20.
Мне до кончика хвоста любопытно, когда же вы наконец поймете, что не видя, что не работает, никто не ответит, почему не работает? И что количество повторов вашего вопроса на итог не влияет?
Когда Цитата dmitrijaltman8, 29.08.2021 в 04:19, в сообщении № 5 ( писал(а)): адреса по ссылкам - реально существуют гиперссылки работают.
Мне до кончика хвоста любопытно, когда же вы наконец поймете, что не видя, что не работает, никто не ответит, почему не работает? И что количество повторов вашего вопроса на итог не влияет?
что не видя, что не работает, никто не ответит, почему не работает?
Вот щелкаю по созданной макросом ссылке. Вылетает вот такое окно (показано на скриншоте):
Ссылка создана макросом: [vba]
Код
Private Sub Worksheet_Calculate()
On Error Resume Next Set A = [A48:B87].SpecialCells(xlCellTypeConstants) If Err = 0 Then Application.EnableEvents = False On Error GoTo 0 For Each Cell In A If Cell.Hyperlinks.Count = 0 Then adr = Cell Cell.ClearContents Cell.Hyperlinks.Add Anchor:=Cell, Address:=Cell, SubAddress:= _ adr, TextToDisplay:=adr End If Next Application.EnableEvents = True End If
End Sub
[/vba] В коде я - ничего не менял. Что еще нужно показать ?
что не видя, что не работает, никто не ответит, почему не работает?
Вот щелкаю по созданной макросом ссылке. Вылетает вот такое окно (показано на скриншоте):
Ссылка создана макросом: [vba]
Код
Private Sub Worksheet_Calculate()
On Error Resume Next Set A = [A48:B87].SpecialCells(xlCellTypeConstants) If Err = 0 Then Application.EnableEvents = False On Error GoTo 0 For Each Cell In A If Cell.Hyperlinks.Count = 0 Then adr = Cell Cell.ClearContents Cell.Hyperlinks.Add Anchor:=Cell, Address:=Cell, SubAddress:= _ adr, TextToDisplay:=adr End If Next Application.EnableEvents = True End If
End Sub
[/vba] В коде я - ничего не менял. Что еще нужно показать ?dmitrijaltman8
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
