Excel цвет шрифта который вывожу через скрипт, как применить цвет к вариантам?

Всем привет, недавно увлекса екселем, вообщем проверяю доступность урлов, есть два варианта, 1 доступен, 2 не доступен, к первому я хочу применить зеленый цвет шрифта, ко второму красный, как мне в скрипте к вариантам добавить цвета?

Sub Кнопка1_Щелчок()
    
    Dim cell As Range
    Dim winHttpReq As Object
    Set winHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    On Error GoTo l_error
        
    For Each cell In Range("Таблица1").Columns(1).Cells
        
        cell.Offset(0, 1).Value = "Неверный адрес"
        Call winHttpReq.Open("GET", cell.Value, False)
        
        Call winHttpReq.Send
        If winHttpReq.Status = 200 Then
            cell.Offset(0, 1).Value = "РАБОТАЕТ"
        Else
            cell.Offset(0, 1).Value = "НЕ РАБОТАЕТ"
        End If
        
l_error:


И второй вопрос возник, вылезает ошибка при проверке, как сделать если есть пустые ячейки, чтоб он не пытался их проверить, а он пытается и вылезает ошибка.

6173d4ee9c169971766247.png
  • Вопрос задан
  • 72 просмотра
Решения вопроса 1
ws17
@ws17 Автор вопроса
Кому нужен более проработанный скрипт ловите, по поводу цвета, можно через скрипт применять, а можно через (условное форматирование). Я так и сделал.

Function GetURLstatus(ByVal URL$) As Long
    On Error Resume Next: URL$ = Replace(URL$, "\", "/")
    Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
    xmlhttp.Open "GET", URL, "False"
    xmlhttp.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
    xmlhttp.send
    GetURLstatus = Val(xmlhttp.Status)
    Set xmlhttp = Nothing
End Function

Sub Кнопка1_Щелчок()
For Each cell In Range("Таблица1").Columns(1).Cells
If cell.Value <> "" Then
    cell.Offset(0, 1).Value = "Проверка..."
    s = cell.Value
    If UCase(Left(s, 4)) = "HTTP" Then
    ss = GetURLstatus(s)
    Select Case ss
    Case 200: cell.Offset(0, 1).Value = "РАБОТАЕТ"
    'Case 400 To 600: cell.Offset(0, 1).Value = "НЕ РАБОТАЕТ"
    Case Else: cell.Offset(0, 1).Value = "НЕ РАБОТАЕТ"
    End Select
    Else
    cell.Offset(0, 1).Value = "Некорректная ссылка"
    End If
End If
Next
End Sub
Ответ написан
Комментировать
Пригласить эксперта
Ответы на вопрос 1
Krasnoarmeec
@Krasnoarmeec
Изменение цвета:
Красный: cell.Offset(0, 1).Font.Color = RGB(255, 0, 0)
Зелёный: cell.Offset(0, 1).Font.Color = RGB(0, 255, 0)

Проверка на пустые ячейки:
If cell.Value <> "" Then
Ответ написан
Ваш ответ на вопрос

Войдите, чтобы написать ответ

Войти через центр авторизации
Похожие вопросы