Answer the question
In order to leave comments, you need to log in
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:
Answer the question
In order to leave comments, you need to log in
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 questionAsk a Question
731 491 924 answers to any question