ALeXkRU 123
Advanced Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
suomifinland
Цитата:
хмм... так и говорить надо :)
тогда это вопрос не для этого топика.. Макросы нужны (про что сказано в шапке, оранжевеньким ;) ).
Собственно, вот :
Код: Sub EmailToHyperlinksInSelection()
Dim cell As Range: Application.ScreenUpdating = False
For Each cell In Selection ' перебираем все выделенные ячейки
addr1$ = cell.Text ' берем адрес из ячейки
If Len(addr1$) And CheckEmail(addr1$) Then ' если есть и адрес, то
addr$ = "mailto:" & cell.Text ' формируем ссылку
cell.Hyperlinks.Add cell, Address:=addr$, TextToDisplay:=cell.Text ' прописываем гиперссылку
End If
Next cell
End Sub
Function CheckEmail(ByVal email As String) As Boolean
' функция проверяет на корректность (соответствию стандарту)
' адрес почты email, переданный ей в качестве параметра
' (используется проверка на соответствие регулярному выражению)
' Функция возвращает TRUE, если адрес корректный, и FALSE в обратном случае
With CreateObject("vbscript.regexp")
.IgnoreCase = True
.Pattern = "^[\w-\.]+@[\w-\.]+\.\w+$"
CheckEmail = .Test(email)
End With
End Function |
- в файле экселя нужно разрешить использование макросов (в современных, это означает, что расширение файла должно быть .xlsm, можно через Сохранить как.. сделать)
- в файле открыть редактор VBA (через панель Разработчик, или через Alt+F8 / Изменить)
- скопировать приведённый код макроса
- вставить, сохранить
для запуска:
- выделить нужный диапазон (ячейки с адресами в столбце, можно вперемешку с пустыми);
- Alt+F8 , выбрать макрос EmailToHyperlinksInSelection, Выполнить
Добавлено:
ЗЫ: добавил проверку правильности e-mail -адреса..
теперь можно (почти) всё подряд выделять: только ячейки с e-mail-ами в гиперссылки превратятся... |
