Макрос для проверки IP адресов

'==========
Private Declare Function GetRTTAndHopCount Lib "iphlpapi.dll" _
        (ByVal lDestIPAddr As Long, _
         ByRef lHopCount As Long, _
         ByVal lMaxHops As Long, _
         ByRef lRTT As Long) As Long
         
Private Declare Function inet_addr Lib "wsock32.dll" _
        (ByVal cp As String) As Long
 
Public Function SimplePing(sIPadr As String) As Boolean
 
    Dim lIPadr      As Long
    Dim lHopsCount  As Long
    Dim lRTT        As Long
    Dim lMaxHops    As Long
    Dim lResult     As Long
    
    Const SUCCESS = 1
    
    lMaxHops = 10              ' should be enough ...
    
    lIPadr = inet_addr(sIPadr)
    
    SimplePing = (GetRTTAndHopCount(lIPadr, lHopsCount, lMaxHops, lRTT) = SUCCESS)
    
End Function
 
Sub ïðîâåðêà()
  Application.Cursor = xlWait
  r = 1
  Do While Not IsEmpty(Cells(r, 2))
    Application.StatusBar = "идет проверка " & Cells(r, 2) & "..."
    If SimplePing(Cells(r, 2)) Then Cells(r, 3) = "отвечает" Else Cells(r, 3) = "не отвечает"
    r = r + 1
  Loop
  Application.Cursor = xlDefault
  MsgBox "", vbInformation, "готово"
End Sub
'==========

Private Declare Sub Sleep Lib "kernel32" (ByVal milliseconds As Long)

Sub проверка()
  Application.Cursor = xlWait
  r_beg = 1   ' с  какой строки идут адреса
  r_end = 100 ' до какой строки
  x_adr = 9   ' колонка с адресами
  x_st = 8    ' колонка со статусами
  
  UserForm1.Show (vbModeless)
  
  For r = r_beg To r_end
    If Not IsEmpty(Cells(r, x_adr)) Then
      'Application.StatusBar = "идет проверка " & Cells(r, x_adr) & "..."
      UserForm1.Label1.Caption = "идет проверка " & Cells(r, x_adr) & "..."
      UserForm1.Repaint
      Sleep 500
      If SimplePing(Cells(r, x_adr)) Then Cells(r, x_st) = "работает" Else Cells(r, x_st) = "не работает"
    End If
  Next
  
  Application.Cursor = xlDefault
  Unload UserForm1
  MsgBox "", vbInformation, "Готово"
End Sub