A
A
Anton2021-10-23 12:06:13
excel
Anton, 2021-10-23 12:06:13

Excel font color that I output through the script, how to apply color to options?

Hello everyone, I recently got carried away with excel, in general I check the availability of urls, there are two options, 1 is available, 2 is not available, I want to apply a green font color to the first one, red to the second one, how can I add colors to the options in the script?

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:


And the second question arose, an error pops up when checking, how to do if there are empty cells, so that he does not try to check them, but he tries and an error comes out.

6173d4ee9c169971766247.png

Answer the question

In order to leave comments, you need to log in

2 answer(s)
A
Anton, 2021-10-24
Websaytovsky @ws17

Who needs a more elaborate script, catch about the color, you can apply it through the script, or you can use it (conditional formatting). That's exactly what I did.

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

Didn't find what you were looking for?

Ask your question

Ask a Question

731 491 924 answers to any question