Sub Ping_Adresse_IP()
Dim Rg As Range
Dim c As Range
Dim Message, V As String
Dim Sh As Worksheet
'************ Variable à définir*****************
Set Sh = Worksheets("Feuil1")
'***********************************************
With Sh
'Définir la plage de cellules où sont les adresses
Set Rg = .Range("A1:A" & .Range("A" & .Cells.Rows.Count).End(xlUp).Row)
End With
For Each c In Rg
Message = sPing(c)
c.Offset(, 1) = Message
c.Offset(, 2) = Time
Next
Sh.Columns("A:C").EntireColumn.AutoFit
Set Rg = Nothing: Set c = Nothing: Set Sh = Nothing
End Sub
'---------------------------------------------------------
Cette fonction émane de ce site Web
[URL="https://social.technet.microsoft.com/Forums/scriptcenter/en-us/e59a38e1-eaf0-4b13-af10-fd4be559f50f/ping-from-vba-in-excel"]https://social.technet.microsoft.com/Forums/scriptcenter/en-us/e59a38e1-eaf0-4b13-af10-fd4be559f50f/ping-from-vba-in-excel[/URL]
'---------------------------------------------------------
Function sPing(sHost) As String
Dim oPing As Object, oRetStatus As Object
Set oPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _
("select * from Win32_PingStatus where address = '" & sHost & "'")
For Each oRetStatus In oPing
If IsNull(oRetStatus.StatusCode) Or oRetStatus.StatusCode <> 0 Then
sPing = "Status code is " & oRetStatus.StatusCode
Else
sPing = "Pinging " & sHost & " with " & oRetStatus.BufferSize & " bytes of data:" & Chr(10) & Chr(10)
sPing = sPing & "Time (ms) = " & vbTab & oRetStatus.ResponseTime & Chr(10)
sPing = sPing & "TTL (s) = " & vbTab & vbTab & oRetStatus.ResponseTimeToLive
End If
Next
End Function