нерабочие гиперссылки

[Jaroslav]

Добрый день. У меня такой код:

For Each Cell In Selection
        i = Cell.Hyperlinks.Count
        If i = 0 Then
            MsgBox "В ячейках нету гиперссылок"
            Exit Sub
        End If
        On Error GoTo 10
        Cell.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
10 Err.Clear
Next

Если в выделенных ячейках 1 гиперссылка нерабочая, 2 рабочая, 3 нерабочая, то 1 гиперссылку не открывает, 2 открывает, а на 3 выдает ошыбку: Run-Time error '-2146697210 (800c0006)'. Узел интернета сообщил, что нужный документ не найден. (HTTP/1.0 404).
Ребята, почему при 1 нерабочей гиперссылки такой ошибки не видает, а при 3 видает? Почему на 3 гиперссылке не работает On Error?

[Jaroslav]

Прилагаю файл с 3 гиперссылками

[Казанский]

В этом коде нет нормального обработчика ошибок. Попробуйте так

Dim hlnk As Hyperlink
If Selection.Hyperlinks.Count = 0 Then
  MsgBox "В ячейках нету гиперссылок"
  Exit Sub
End If
On Error Resume Next
For Each hlnk In Selection.Hyperlinks
  hlnk.Follow NewWindow:=False, AddHistory:=True
Next

[Jaroslav]

Казанский, я так понимаю, если гиперссылка неработающая, то должна выполнятся строка после

hlnk.Follow NewWindow:=False, AddHistory:=True

? дело в том, что я привел код не полностью и после:

Cell.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True

у меня идет большой кусок программы, в котором кликается на ссылке в интернете, которая открыта из ексель

[Jaroslav]

Можно ли как-то пропускать гиперссылки, которые не открываются в браузере?

[Казанский]

Dim hlnk As Hyperlink
If Selection.Hyperlinks.Count = 0 Then
  MsgBox "В ячейках нету гиперссылок"
  Exit Sub
End If
On Error Resume Next
For Each hlnk In Selection.Hyperlinks
  hlnk.Follow NewWindow:=False, AddHistory:=True
  If Err Then 'плохая гиперссылка
    Err.Clear
  Else
    'здесь работа с открывшейся ссылкой
  End If
Next

[Казанский]

или так, с использованием классического бейсиковского механизма обработки ошибок

Dim hlnk As Hyperlink
If Selection.Hyperlinks.Count = 0 Then
  MsgBox "В ячейках нету гиперссылок"
  Exit Sub
End If
On Error GoTo 10
For Each hlnk In Selection.Hyperlinks
  hlnk.Follow NewWindow:=False, AddHistory:=True
    'здесь работа с открывшейся ссылкой
1 Next
'...
Exit Sub

10 Resume 1 'это обработчик ошибки
End Sub

[Jaroslav]

Спасибо, Казанский

[Mazajka]

Казанский, здравствуйте!Помогите, пожалуйста!
Каждый день мне приходится проверять рабочесть ссылок с переходом по URL (фото прилагаю). Мне нужно написать такой макрос, чтобы при выделении определенных ячеек и запуске этого макроса, все эти ссылки открылись в браузере.

Я вроде бы написала скрипт:
Public Sub ссылки3()
Dim CHs As Range
Dim CH As Range
Dim i As Integer

Set CHs = Selection.Cells
i = 0

For Each CH In CHs
CH.Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
DoEvents
Next
End Sub.

Но вот как обойти ошибку следующего характера: Если ссылка нерабочая, то макрос выдает ошибку. Как изменить строку "Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True"?

[Mazajka]

Казанский, здравствуйте!Помогите, пожалуйста!
Каждый день мне приходится проверять рабочесть ссылок с переходом по URL (фото прилагаю). Мне нужно написать такой макрос, чтобы при выделении определенных ячеек и запуске этого макроса, все эти ссылки открылись в браузере.

Я вроде бы написала скрипт:
Public Sub ссылки3()
Dim CHs As Range
Dim CH As Range
Dim i As Integer

Set CHs = Selection.Cells
i = 0

For Each CH In CHs
CH.Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
DoEvents
Next
End Sub.

Но вот как обойти ошибку следующего характера: Если ссылка нерабочая, то макрос выдает ошибку. Как изменить строку "Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True"?