Effectuer un ping depuis une IP ecrite dans une cellule

Re bonjour,

je souhaiterais maintenant pouvoir recuperer l'adresse ip depuis une cellule pour effectuer un ping sur celle ci.

Par contre je n'ai pas besoin de recuperer le resultat du ping dans une cellule ou un fichier, juste voir le ping s'executer sera suffisant.

J'ai trouvé des choses sur internet,cela semble donc possible, mais je n'y comprend rien (scripts vba trop compliqué pour mon niveau pour que je l'adapte a ma feuille)

L'adresse Ip sera inscrit sur la cellule B5 de mes feuilles.

Par contre je ne pourrais repasser que demain sur le forum, dites moi s'il vous faut plus d'information

Merci par avance pour votre aide precieuse !

Salut le forum

Pour débuter la discussion

Attribute VB_Name = "Ping_IP"

'   Pasquier Denis 03.2002
'   Controle si num ip est accessible
'   Comme la commande ping

Option Explicit
Const SOCKET_ERROR = 0

Private Type WSAdata
    wVersion As Integer
    wHighVersion As Integer
    szDescription(0 To 255) As Byte
    szSystemStatus(0 To 128) As Byte
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpVendorInfo As Long
End Type

Private Type Hostent
    h_name As Long
    h_aliases As Long
    h_addrtype As Integer
    h_length As Integer
    h_addr_list As Long
End Type

Private Type IP_OPTION_INFORMATION
    TTL As Byte
    Tos As Byte
    Flags As Byte
    OptionsSize As Long
    OptionsData As String * 128
End Type

Private Type IP_ECHO_REPLY
    Address(0 To 3) As Byte
    Status As Long
    RoundTripTime As Long
    DataSize As Integer
    Reserved As Integer
    data As Long
    Options As IP_OPTION_INFORMATION
End Type

Private Declare Function GetHostByName Lib _
    "wsock32.dll" Alias "gethostbyname" _
        (ByVal HostName As String) As Long
Private Declare Function WSAStartup Lib _
    "wsock32.dll" (ByVal wVersionRequired&, _
        lpWSAdata As WSAdata) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" _
    () As Long
Private Declare Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, _
        ByVal cbCopy As Long)
Private Declare Function IcmpCreateFile Lib "icmp.dll" _
    () As Long
Private Declare Function IcmpCloseHandle Lib "icmp.dll" _
    (ByVal HANDLE As Long) As Boolean
Private Declare Function IcmpSendEcho Lib "ICMP" _
    (ByVal IcmpHandle As Long, ByVal DestAddress As Long, _
        ByVal RequestData As String, _
            ByVal RequestSize As Integer, RequestOptns As _
                IP_OPTION_INFORMATION, ReplyBuffer As IP_ECHO_REPLY, _
                    ByVal ReplySize As Long, ByVal TimeOut As Long) As Boolean

Function IP_connect(HostName)
    'Dim HostName
    'HostName = ActiveCell.Value
    Dim hFile As Long, lpWSAdata As WSAdata
    Dim hHostent As Hostent, AddrList As Long
    Dim Address As Long, rIP As String
    Dim OptInfo As IP_OPTION_INFORMATION
    Dim EchoReply As IP_ECHO_REPLY
    Call WSAStartup(&H101, lpWSAdata)
    If GetHostByName(HostName + _
    String(64 - Len(HostName), 0)) _
    <> SOCKET_ERROR Then
        CopyMemory hHostent.h_name, _
        ByVal GetHostByName(HostName + _
        String(64 - Len(HostName) _
        , 0)), Len(hHostent)
        CopyMemory AddrList, ByVal hHostent.h_addr_list, 4
        CopyMemory Address, ByVal AddrList, 4
    End If
    hFile = IcmpCreateFile()
    If hFile = 0 Then
        'MsgBox "Unable to Create File Handle"
        IP_connect = "Unable to Create File Handle"
        Exit Function
    End If
    OptInfo.TTL = 255
    If IcmpSendEcho(hFile, Address, _
    String(32, "A"), 32, OptInfo, EchoReply, _
    Len(EchoReply) + 8, 2000) Then
        rIP = CStr(EchoReply.Address(0)) + _
        "." + CStr(EchoReply.Address(1)) + "." + _
        CStr(EchoReply.Address(2)) + "." + _
        CStr(EchoReply.Address(3))
    Else
        'MsgBox "Timeout"
        IP_connect = "Timeout"
    End If
       If EchoReply.Status = 0 Then
        'MsgBox "Reply from " + HostName + " (" + rIP _
        + ") recieved after " + _
        Trim$(CStr(EchoReply.RoundTripTime)) + "ms"
        IP_connect = "Reply from " + HostName + " (" + rIP _
        + ") recieved after " + _
        Trim$(CStr(EchoReply.RoundTripTime)) + "ms"
    Else
        'MsgBox "Failure ..."
        IP_connect = "Failure ..."
    End If
    Call IcmpCloseHandle(hFile)
    Call WSACleanup
End Function

Sub Boucle_sur_selection()
    Dim Sel As Range
    Dim Cel As Range
    Dim message
    Dim nF As Worksheet
    Set Sel = Selection
    Set nF = ActiveWorkbook.Sheets.Add
    For Each Cel In Sel
        message = IP_connect(Cel.Value)
        ActiveCell = Cel
        ActiveCell.Offset(0, 1) = message
        ActiveCell.Offset(0, 2) = Time
        ActiveCell.Offset(1, 0).Range("A1").Select
    Next Cel
    Columns("A:C").EntireColumn.AutoFit
    Set Sel = Nothing
    Set nF = Nothing
End Sub

Mytå

Bonjour,

le ping fonctionne bien par contre cela me créé une feuille supplementaire pour afficher le resultat du ping

Serait il possible que ce resultat apparaissent sur la feuille active à partir de laquelle la feuille s'effectue

Ou alors que l'on attribue une feuille pour ces resultats ?

j'ai deja plus de 200 feuilles nommées dans mon fichier excel et a l'usage cela risque de creer une confusion (je ne serais pas l'utilisateur final de ce document)

De plus j'aimerais mettre cette fonction derriere un bouton sur chaque page, l'adresse etant toujours dans les memes cellules (cellule B5 quelque soit la feuille)

Il s'agit d'un plan d'adressage IP avec une feuille par adresse.

Merci en tout cas pour votre reponse

Bonjour,

pas de nouvelles ? J'vais essayer d'me debrouiller tout seul pour modifier ca (a mon avis c'est pas gagné)

merci

Re le forum

Voila ta boucle qui va écrire le résultat dans la cellule à droite de l'adresse IP (Défusionne les cellules)

Sub Boucle_sur_selection()
    Dim Sel As Range
    Dim Cel As Range
    Dim message

    Set Sel = Range("A3:A27,C3:C27") 'Plage à compléter
    For Each Cel In Sel
        message = IP_connect(Cel.Value)
        Cel.Offset(0, 1) = message
    Next Cel

    Set Sel = Nothing

End Sub

Mytå