Macro no devuelve ningún valor y me sale mensaje de interrupción aunque yo no interrumpa

Buenas tardes expertos, por favor necesito ayuda tengo mi código de macros que hace ping a unos ip que están en una planilla de excel los cuales los recibe por parámetro y dentro hace ping y saca la información relevante (numero de paquetes recibidos, nombre de maquina y si esta o no vacante el IP ) y la cosa es que mi idea era que cuando la hoja se abriera se ejecutara la macro solamente en la hoja abierta. Pero creo que no me funciona , envío el código para que vean y me puedan dar consejos de como mejorar el código. De antemano por su ayuda , Muchas Gracias a todos .

Private Sub Worksheet_activate()
Application.OnTime Now() + TimeValue("00:00:05"), "esta"
End Sub
Sub esta()
Application.Calculation = xlCalculationAutomatic
End Sub
Public Function f_EquipoResponde(str_Equipo As String) As String
Dim obj_Shell As Object
Dim obj_FileSystem As Object
Dim obj_Fichero As Object
Dim str_ContenidoFichero As String
Dim str_FicheroTemporal As String
Dim str_NombreMaquina As String
Set obj_Shell = CreateObject("WScript.Shell")
Set obj_FileSystem = CreateObject("Scripting.FileSystemObject")
str_FicheroTemporal = ThisWorkbook.Path & "\temp.txt"
obj_Shell.Run "cmd /c ping -a -n 2 -w 100" & str_Equipo & " > """ & _
str_FicheroTemporal & """", 0, True
Set obj_Fichero = obj_FileSystem.OpenTextFile(str_FicheroTemporal, 1, False)
str_ContenidoFichero = obj_Fichero.ReadAll
obj_Fichero.Close
Set obj_Fichero = Nothing
obj_FileSystem.DeleteFile (str_FicheroTemporal)
Set obj_FileSystem = Nothing
Set obj_Shell = Nothing
Dim Nombre As String
Nombre = Mid(Replace(str_ContenidoFichero, vbCrLf, ""), 18, 10)
If InStr(str_ContenidoFichero, "perdidos = 0") > 0 Then
f_EquipoResponde = Nombre & " ha RECIBIDOS 100%"
End If
If InStr(str_ContenidoFichero, "perdidos = 1") > 0 Then
f_EquipoResponde = Nombre & "ha RECIBIDOS 50%"
End If
If InStr(str_ContenidoFichero, "perdidos = 2") > 0 Then
f_EquipoResponde = "IP VACANTE"
End If
End Function