Changer une couleur en fonction d'un ping

Salut

Je voulais savoir si il était possible de changer une couleur en fonction d'un ping ?

Par exemple j'ai une liste d'adresse IP, j'aimerais que la cellule soit verte si elle ping ou rouge si elle ping pas,

Si cela est possible, pouvez vous m'expliquer ? merci !

Bonjour,

ping est une commande dos, qu'il faut exécuter dans une fenêtre de commande (shell)

il faut préparer un fichier de commande dos contenant la commande ping

lancer la commande ping

mettre la réponse dans un fichier

lire la réponse

en fonction de la réponse mettre la cellule en vert ou en rouge

le tout en gérant le timing entre excel et la fenêtre de commande.

voici une exemple

Sub pingcolor()
    For Each adresse In Sheets("sheet1").Range("A1:A5")
        adresse.Interior.Color = xlNone
        ch = "d:\downloads\" ' répertoire où mettre les fichiers de travail
        sfile = ch & adresse.Value & "reponseping.txt"
        cmd = ch & adresse.Value & "pingscript.bat"
        On Error Resume Next
        Kill sfile
        Kill cmd
        On Error GoTo 0
        Open cmd For Output As 1
        Print #1, "ping " & adresse.Value & " >" & sfile
        Print #1, "echo end of file >> " & sfile
        Print #1, "Quit"
        Close 1
        Set wsh = VBA.CreateObject("WScript.Shell")
        waitonreturn = True
        windowstyle = 0
        wsh.Run cmd, windowstyle, waitonreturn
        Set wsh = Nothing
        r = ""
        While InStr(r, "end of file") = 0
            Open sfile For Input As #1
            r = Input$(LOF(1), #1)
            Close 1
        Wend
        If InStr(r, "Approximate round trip") <> 0 Then
            adresse.Interior.Color = vbGreen
        Else
            adresse.Interior.Color = vbRed
        End If
    Next
End Sub

Merci pour ta réponse,

Ha d'accord, c'est plutôt complexe je trouve, mais merci pour l'exemple je vais essayer ça !

merci

Bonjour,

en cherchant sur le net, j'ai trouvé ceci (stackoverflow) que j'ai complété pour y mettre les couleurs

https://stackoverflow.com/questions/21020077/ping-ip-address-with-vba-code-and-return-results-in-excel

Function GetPingResult(Host)

    Dim objPing As Object
    Dim objStatus As Object
    Dim Result As String

    Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}"). _
                  ExecQuery("Select * from Win32_PingStatus Where Address = '" & Host & "'")

    For Each objStatus In objPing
        Select Case objStatus.StatusCode
        Case 0: strResult = "Connected"
        Case 11001: strResult = "Buffer too small"
        Case 11002: strResult = "Destination net unreachable"
        Case 11003: strResult = "Destination host unreachable"
        Case 11004: strResult = "Destination protocol unreachable"
        Case 11005: strResult = "Destination port unreachable"
        Case 11006: strResult = "No resources"
        Case 11007: strResult = "Bad option"
        Case 11008: strResult = "Hardware error"
        Case 11009: strResult = "Packet too big"
        Case 11010: strResult = "Request timed out"
        Case 11011: strResult = "Bad request"
        Case 11012: strResult = "Bad route"
        Case 11013: strResult = "Time-To-Live (TTL) expired transit"
        Case 11014: strResult = "Time-To-Live (TTL) expired reassembly"
        Case 11015: strResult = "Parameter problem"
        Case 11016: strResult = "Source quench"
        Case 11017: strResult = "Option too big"
        Case 11018: strResult = "Bad destination"
        Case 11032: strResult = "Negotiating IPSEC"
        Case 11050: strResult = "General failure"
        Case Else: strResult = "Unknown host"
        End Select
        GetPingResult = strResult
    Next

    Set objPing = Nothing

End Function

Sub GetIPStatus()

    Dim Cell As Range
    Dim ipRng As Range
    Dim Result As String
    Dim Wks As Worksheet

    Set Wks = Worksheets("Sheet1") ' à adapter

    Set ipRng = Wks.Range("A1:A5") ' à adapter
    Set RngEnd = Wks.Cells(Rows.Count, ipRng.Column).End(xlUp)
    Set ipRng = IIf(RngEnd.Row < ipRng.Row, ipRng, Wks.Range(ipRng, RngEnd))

    For Each Cell In ipRng
        Result = GetPingResult(Cell)
        If Result = "Connected" Then
            Cell.Interior.Color = vbGreen
        Else
            Cell.Interior.Color = vbRed
        End If
        Cell.Offset(0, 1) = Result
    Next Cell

End Sub