Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Открыть гиперссылку в ячейке другим браузером (не браузером по умолчанию) в диапазоне
 
#1
17.02.2017 18:19:29
Добрый вечер всем !
Данная тема конечно подымалась на страницах форума но ответа для моего случая не нашел
На листе в диапазоне С4:C100 в ячейках гиперссылки
Их надо открывать только портабельным браузером Opera ("""" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe""") - папка с портабельным браузером в директории файла
При этом есть InternetExplorer который открывает ссылки по умолчанию - его надо исключить (советы по смене браузера по умолчанию в данной ситуации не подходят)
Задаем чем открывать что открывать
Чем открывать  - ("""" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe""") - папка с портабельным браузером
Что открывать - активную ячейку только в диапазоне  С4:C100 с гиперссылкой

1. Проблема1 -Вот так будет работать если явно задать www-адрес
вариации разные
1.1) x = Shell("""" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe""" & """http://www.planetaexcel.ru""", vbNormalNoFocus)
1.2)operaPath = """" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe"""
Shell (operaPath & " -url http://www.planetaexcel.ru"), vbNormalFocus
1.3)Shell """" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe""" & "http://www.planetaexcel.ru", vbNormalFocus
итого Проблема1 - будет открываться Opera которая явно задана  и одновременно  автоматом другой браузер по умолчанию (а нужно чтобы только Opera открывалась)

Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(ActiveCell, Range("C4:C100")) Is Nothing Then
If Target.Cells.Count > 1 Then Exit Sub 
x = Shell("""" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe""" & """http://www.planetaexcel.ru""", vbNormalNoFocus)
'operaPath = """" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe"""
'Shell (operaPath & " -url http://www.planetaexcel.ru"), vbNormalFocus 
'Shell """" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe""" & "http://www.planetaexcel.ru", vbNormalFocus
End If
Exit Sub

2.Проблема2 связанная  - видимо нужно ввести  myHyperlink.Address либо просто Hyperlink.Address либо ActiveCell.Text чтоб реагировало правильно на клик в ячейке
1.1) x = Shell("""" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe""" & myHyperlink.Address, vbNormalNoFocus)
1.2)operaPath = """" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe"""
Shell (operaPath & " -url myHyperlink.Address"), vbNormalFocus
1.3)Shell """" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe""" & myHyperlink.Address, vbNormalFocus

не получается так или Hyperlink.Address или его не использовать - сделать ActiveCell.Text ?

Как задать свой  браузер  чтоб открывался  только он по клику на активную ячейку с гиперссылкой(а браузер по умолчанию не открывался при этом)  и как ввести Hyperlink.Address правильно ?
Изменено: fix555 - 17.02.2017 18:51:08
 
 
 
#2
17.02.2017 19:09:31
Цитата
fix555 написал:
будет открываться Opera которая явно задана  и одновременно  автоматом другой браузер по умолчанию
Если не побрезгуете переделать существующие гиперссылки в ячейках под формулу вида =ГИПЕРССЫЛКА("","http://google.com")
Тогда можно поизвращаться над кодом:
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(ActiveCell, Range("C4:C100")) Is Nothing Then
If Target.Cells.Count > 1 Then Exit Sub
    If InStr(Target.FormulaLocal, "ГИПЕРССЫЛКА") > 0 Then
    URL = Target.Text
    operaPath = """" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe"""
    x = Shell("""" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe""" & URL, vbNormalNoFocus)
    Shell (operaPath & " -url " & URL), vbNormalFocus
    Shell """" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe""" & URL, vbNormalFocus
    End If
End If
End Sub
Не проверял, портабл оперы нет, искать и качать лень.
Изменено: Jungl - 17.02.2017 19:12:29
 
 
 
#3
17.02.2017 19:17:45
тогда так чтоли делать забыли заменить или неправ
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(ActiveCell, Range("C4:C100")) Is Nothing Then
If Target.Cells.Count > 1 Then Exit Sub
    If InStr(Target.FormulaLocal, "ГИПЕРССЫЛКА") > 0 Then
    Shell """" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe""" & "ГИПЕРССЫЛКА", vbNormalFocus
    End If
End If
End Sub
Изменено: fix555 - 17.02.2017 19:20:17
 
 
 
#4
17.02.2017 19:19:07
fix555, URL берет из Target.Text. Выше поправил код.
 
 
 
#5
17.02.2017 19:27:13
че то не хочется колдовать с Replace  и загонять в переменные  хочется более изящное решение и плюсом проблема одновременного открытия 2 браузеров не решится только гиперссылка решится
Изменено: fix555 - 17.02.2017 19:31:03
 
 
 
#6
17.02.2017 19:33:26
fix555, особо вариантов нет.
При клике сначала срабатывает открытие гиперссылки, потом уже Worksheet_SelectionChange.
1. Использовать то, что выше.
2. Редактировать regedit, заменяя стандартный браузер на свой.
3. Удалить из ячеек фунекцию гиперссылок, оставив только текст. И кодом проверять ссылку -  если http или www, открывать в браузере. Курсор мыши при этом не изменится.
4. Может быть через API функции.
 
 
 
#7
17.02.2017 19:37:28
а что делать :)  легких путей не ищем будем искать на англицком я думаю что проще изменить браузер по умолчанию программно а потом вернуть  как это сделать пока на знаю   но это снимает промежуточные проблемы  тут подходит ваш путь 2  regedit
Изменено: fix555 - 17.02.2017 19:49:43
 
 
 
#8
17.02.2017 19:49:11
Цитата
fix555 написал:
легких путей не ищем
Тогда вам ответ уже дан выше.
Если где-то найдется API функция, считайте это еще + десяток-две строчки кода. Такой путь ищете?
Цитата
fix555 написал:
будем искать на англицком
не забудьте поделиться результатом. Спасибо.
 
 
 
#9
17.02.2017 19:51:09
Jungl изменил текст путь 2  Батник делаем 2 шт - один меняет другой возвращает ?
Если так то делаем *.bat файл со сменой значения реестра потом по условию клика "не в диапазоне" делаем 2  *.bat файл который возвращает значения реестра ?
Ни разу не делал такого - интересно
Изменено: fix555 - 17.02.2017 20:02:09
 
 
 
#10
17.02.2017 20:01:33
fix555, попробуйте. Под обычной учетной записью(не администратор), вряд ли записать получится в реестр.
Зачем батник? При открытии книги делаете запись в реестр, при закрытии возвращаете обратно.
p.s. чем мой код не "изящное решение"? Вы у себя только гиперссылки переводите на формульный вид.
Код
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(ActiveCell, Range("C4:C100")) Is Nothing Then
    If InStr(Target.FormulaLocal, "ГИПЕРССЫЛКА") > 0 Or InStr(Target.FormulaLocal, "HYPERLINK") > 0 Then
        Shell """" & ThisWorkbook.Path & "\FirefoxPortable.exe""" & " -url " & Target.Text, vbNormalFocus
    End If
End If
 
 
 
#11
17.02.2017 20:06:03
А обязательно "ладошкой" - я про гиперссылку? )) Может на правый или двойной клик посадить?
 
 
 
#12
17.02.2017 20:10:09
В этой теме Игорь давал ссылку на решение, как открывать разными обозревателями - может что и пригодится ))
 
 
 
#13
17.02.2017 20:12:36
вы какбы обходите администратора  можно   под  администратором ведь пароль и логин администратора знаю комп локальный
решение не сетевое значит батники пишем в реестр   а что делать тупо но надежно ( хотя с какой стороны посмотреть ?? - антивирус точно будет ругаться на макрос на изменение в реестре)  тупик ....  :)   будем искаать
Изменено: fix555 - 17.02.2017 20:33:41
 
 
 
#14
18.02.2017 11:14:46
Кажется нашел в каком направлении копать - нужно сначала снять гиперссылку в активной ячейке - потом открывать своим браузером - потом (после открытия страницы) по желанию вернуть гиперссылку на ячейку
те если в ячейке только текст ссылки - не гиперссылка - то браузер по умолчанию не открывается и открывается только выбранный браузер
однако сейчас в таком коде все равно лезет браузер по умолчанию - хотя с ячейки предварительно снимаю гиперссылку отдельным If
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(ActiveCell, Range("C4:С100")) Is Nothing Then
If Target.Cells.Count > 1 Then Exit Sub

Dim url As String
Dim operaPath As String

operaPath = """" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe"""
url = ActiveCell.Value

If ActiveCell.Value <> "" Then
Selection.Hyperlinks.Delete
Else
Exit Sub
End If

If ActiveCell.Value Like "*http://*" Or ActiveCell.Value Like "*https://*" Then
'Selection.Hyperlinks.Delete
'Application.Wait Now + TimeSerial(0, 0, 10)

    Shell operaPath & url, vbNormalNoFocus
Else
Exit Sub
End If

End If
End Sub
Изменено: fix555 - 18.02.2017 11:20:31
 
 
 
#15
18.02.2017 12:08:34
Цитата
fix555 написал:
однако сейчас в таком коде все равно лезет браузер по умолчанию
я ведь вам говорил
Цитата
я ведь вам писал:
При клике сначала срабатывает открытие гиперссылки, потом уже Worksheet_SelectionChange.
:)
 
 
 
#16
18.02.2017 13:52:41
Тогда так делаем без снятия гиперссылок  - вроде заработало
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(ActiveCell, Range("C4:C5003")) Is Nothing Then
If Target.Cells.Count > 1 Then Exit Sub

Dim url As String
Dim operaPath As String
 
operaPath = """" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe"""
url = ActiveCell.Value
 
If ActiveCell.Value Like "*http://*" Or ActiveCell.Value Like "*https://*" Then
    Shell operaPath & url, vbNormalNoFocus
    Shell "cmd.exe /c " & "Taskkill" & " " & "/f" & " " & "/im" & " " & "iexplore.exe"
Else
Exit Sub
End If

End If
End Sub
Изменено: fix555 - 18.02.2017 14:10:02
 
 
 
Страницы: 1
Наверх