Добрый вечер всем ! Данная тема конечно подымалась на страницах форума но ответа для моего случая не нашел На листе в диапазоне С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 написал: будет открываться 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
Не проверял, портабл оперы нет, искать и качать лень.
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
че то не хочется колдовать с Replace и загонять в переменные хочется более изящное решение и плюсом проблема одновременного открытия 2 браузеров не решится только гиперссылка решится
fix555, особо вариантов нет. При клике сначала срабатывает открытие гиперссылки, потом уже Worksheet_SelectionChange. 1. Использовать то, что выше. 2. Редактировать regedit, заменяя стандартный браузер на свой. 3. Удалить из ячеек фунекцию гиперссылок, оставив только текст. И кодом проверять ссылку - если http или www, открывать в браузере. Курсор мыши при этом не изменится. 4. Может быть через API функции.
а что делать легких путей не ищем будем искать на англицком я думаю что проще изменить браузер по умолчанию программно а потом вернуть как это сделать пока на знаю но это снимает промежуточные проблемы тут подходит ваш путь 2 regedit
Jungl изменил текст путь 2 Батник делаем 2 шт - один меняет другой возвращает ? Если так то делаем *.bat файл со сменой значения реестра потом по условию клика "не в диапазоне" делаем 2 *.bat файл который возвращает значения реестра ? Ни разу не делал такого - интересно
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
вы какбы обходите администратора можно под администратором ведь пароль и логин администратора знаю комп локальный решение не сетевое значит батники пишем в реестр а что делать тупо но надежно ( хотя с какой стороны посмотреть ?? - антивирус точно будет ругаться на макрос на изменение в реестре) тупик .... будем искаать
Кажется нашел в каком направлении копать - нужно сначала снять гиперссылку в активной ячейке - потом открывать своим браузером - потом (после открытия страницы) по желанию вернуть гиперссылку на ячейку те если в ячейке только текст ссылки - не гиперссылка - то браузер по умолчанию не открывается и открывается только выбранный браузер однако сейчас в таком коде все равно лезет браузер по умолчанию - хотя с ячейки предварительно снимаю гиперссылку отдельным 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
Тогда так делаем без снятия гиперссылок - вроде заработало
Код
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