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

Question

[Антон Вебсайтовский]

Всем привет, недавно увлекса екселем, вообщем проверяю доступность урлов, есть два варианта, 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:

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

Answer 1

[Антон Вебсайтовский]

Кому нужен более проработанный скрипт ловите, по поводу цвета, можно через скрипт применять, а можно через (условное форматирование). Я так и сделал.

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

Answer 2

[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

Comments

[Антон Вебсайтовский]

спасибо, учитывая мой код, как мне применить If cell.Value <> "" Then

[Krasnoarmeec]

If cell.Value <> "" Then и дальше Ваш код.

Что-то вроде

For Each cell In Range("A1:A2").Columns(1).Cells
        If cell.Value <> "" Then

[Антон Вебсайтовский]

Что-то не работает, из-за цвета ошибка.

cell.Offset(0, 1).Font.Color = RGB(0, 255, 0).Value = "РАБОТАЕТ"

Я применил условия форматирования, так вроде лучше, по названию текста ! меняется стиль оформления.

[Антон Вебсайтовский]

Возникла другая проблема, когда идет перебор проверки урлов, то там надпись, проверка..., все верно, но тот сайт что не грузиться, оно не меняет на (не работает), там так и остается надпись, проверка...
Как быть?

[Krasnoarmeec]

Формулы надо применять по отдельности:
cell.Offset(0, 1).Font.Color = RGB(0, 255, 0)
cell.Offset(0, 1).Value = "РАБОТАЕТ".

Если сайт не грузится, может быть сразу написать, что он не работает.
Если но всё же работает, то Ваш алгоритм напишет это потом.

[Krasnoarmeec]

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 = "РАБОТАЕТ"
        End If

[Антон Вебсайтовский]

Krasnoarmeec, Спасибо.
Но щас вышло так, когда идет проверка, то пробегает слово по всем пунктам НЕ РАБОТАЕТ.
А раньше было Проверка..., но если сайт не работает, то не заменялось на НЕ РАБОТАЕТ.
Так что надо как-то до ума довести.

[Krasnoarmeec]

Моё предложение было инициализировать статус величиной "не работает".
Если адрес всё же работает, то статус будет изменён на "работает".

Ваш алгоритм, кстати, требует правильного адреса.
Например, если написать "https://www.incorrect/", то он вылетит по ошибке.

[Антон Вебсайтовский]

Krasnoarmeec, нет ошибки, а вообще да, он требует вставлять https:// как это можно пофиксить, вставляешь с https:// или без. Я понял если ru нет или другого конца, то будет ошибка, как чтоб ошибки не было или писало ошибку, ну выводило, мол не корректно ввели имя сайта.

(Моё предложение было инициализировать статус величиной "не работает".), ну я так и ставил как выше посоветовал, но так когда идет проверка, раньше было слово Проверка..., а щас сразу Не работает. Но если сайт работает, то меняет слово.

А как оставить как было Проверка..., но чтоб все работало и применяло Не работает, если сайт не пашет.

[Krasnoarmeec]

Проверьте на наличие "https://": If InStr(1, cell.Value, "https://") > 0 Then

Вы попробовали поставить "https://www.incorrect/" в середину Вашего списка?
Поверьте/проверьте, дальше Ваш алгоритм не пойдёт, а перейдёт на "l_error:" по ошибке.

Да и вообще, вопрос был про цвета, а не про работу алгоритма...

[Антон Вебсайтовский]

Krasnoarmeec, Да про цвет был вопрос, но чет как закрутилось.

Вы попробовали поставить "https://www.incorrect/" в середину Вашего списка?
Поверьте/проверьте, дальше Ваш алгоритм не пойдёт, а перейдёт на "l_error:" по ошибке.

Да я понял уже, вот как это исправить? чтоб писало мол не правильно ввел урл.

[Антон Вебсайтовский]

Krasnoarmeec, если позволяет опыт допилить, буду рад помощи, отблагодарю )

[Александр]

Антон Вебсайтовский, предложи ему денех ;-|

[idShura]

Антон Вебсайтовский,

если позволяет опыт допилить, буду рад помощи, отблагодарю )

Для начала ответь ответ решением