ping avec couleur vert pour ok et rouge ko

[zergo]

Bonjour le forum

J'ai plusieurs adresses IP sur un des feuilles excel avec les versions antérieurs le ping remontait avec une commande
CMD ping.bat.
Je souhaiterais savoir s il est possible de cliquer sur l IP et remonter une couleur vert ou rouge en fonction de la réponse OK ou KO sur la cellule de l adresse IP.

J'ai joins un fichier XLSM.

Cordialement.

 

[Paf]

Re : ping avec couleur vert pour ok et rouge ko

Bonjour,

Une discussion similaire où il semble y avoir des résultats. A adapter

https://www.excel-downloads.com/threads/ping-depuis-excel-cellule-par-cellule.226621/

Bonne suite

 

[zergo]

Re : ping avec couleur vert pour ok et rouge ko

merci pour t as réponse.

J ai déjà essayé cette macro mais sans solution pour moi.

 

[Paf]

Re : ping avec couleur vert pour ok et rouge ko

Re,

des codes il y en a plusieurs ! et le dernier, après adaptation fonctionne .

1) modification du code de Worksheet_SelectionChange de votre classeur

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'------------------------------PING-HUB-PERE-&-FILS---------------------------
    If Not Application.Intersect(Target, Range("B8")) Is Nothing Then
    Ping_ordinateur Range("B8")
   End If
    
    If Not Application.Intersect(Target, Range("E8")) Is Nothing Then
    Ping_ordinateur Range("E8")
   End If

'-------------------------------PING-NDS-DE-10-11---------------------------
    If Not Application.Intersect(Target, Range("B20")) Is Nothing Then
    Ping_ordinateur Range("B20")
   End If

    If Not Application.Intersect(Target, Range("B23")) Is Nothing Then
    Ping_ordinateur Range("B23")
    End If
End Sub

2 l'adaptation du code de david84

Sub Ping_ordinateur(Adres)
 'sur la base du code de david84 XLD 04/12/2014
 'http://www.excel-downloads.com/forum/226621-ping-depuis-excel-cellule-par-cellule.html
 Dim strComputer As String
 Dim objWMIService As Object
 Dim objStatus As Object
 Dim colPings As Object
 Dim ColIp As Range, c As Range

 strComputer = "."
  Set objWMIService = GetObject( _
      "winmgmts:\\" & strComputer & "\root\cimv2")
  Set colPings = objWMIService.ExecQuery _
      ("Select * From Win32_PingStatus where Address = '" & Adres & "'")
 
  For Each objStatus In colPings
    If IsNull(objStatus.StatusCode) _
        Or objStatus.StatusCode <> 0 Then 'L'ordinateur n'a pas répondu
        Adres.Interior.ColorIndex = 3
    Else
        Adres.Interior.ColorIndex = 4   'L'ordinateur a répondu.
    End If
  Next
  Set objWMIService = Nothing
  Set colPings = Nothing
End Sub

A+

 

[zergo]

Re : ping avec couleur vert pour ok et rouge ko

Bonjour

Je m excuse pour le retard dans ma réponse

la macro fonctionne bien.

je vous en remercie

 

[zergo]

Re : ping avec couleur vert pour ok et rouge ko

Re bonjour au forum

Actuellement j ai un fichier qui fonction très bien

mais je souhaiterais savoir s y il est possible d exécuter les pings a l'ouverture de la feuille "réseaux"

un fichier joint


Bien a vous

 

[Paf]

Re : ping avec couleur vert pour ok et rouge ko

Re,

Dans la feuille de code de la feuille Réseaux ajouter

Private Sub Worksheet_Activate()
 Dim Liste, i as integer
 Liste = Array("B8", "E8", "B20", "B23", "B27") ' liste des cellules sensibles
 For i = LBound(Liste) To UBound(Liste)
    Ping_ordinateur Worksheets("Réseaux").Range(Liste(i))
 Next
End Sub

et déplacer la Sub Ping_ordinateur(Adres) dans un module standard.

A chaque affichage de la feuille Réseaux, la macro sera relancée.

A+

 

[zergo]

Re : ping avec couleur vert pour ok et rouge ko

Salut Paf

je te remercie pour cette info.

ca fonctionne a merveille .

Cordialement

 

[zergo]

Re : ping avec couleur vert pour ok et rouge ko

Bonjour le forum

Je reviens vers vous car la macro me dit que j ai dépassé le nombres de lignes dans le " Private Sub Worksheet_SelectionChange(ByVal Target As Range)"

Vu le nombre d adresses IP a pinger le mieux est de voir le fichier joint.


Dans ce fichier il y a un ping automatique en cliquant sur le bouton de chaque centre , cela fonctionne bien.
ensuite il y a une possibilité de faire un ping individuel sur chaque IP et tout le problème est la , vu le nombre ip.


Cordialement.

 

[Paf]

Re : ping avec couleur vert pour ok et rouge ko

Re

une solution:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
     If Not Application.Intersect(Target, Range("B7:B70, D7:D70, F7:F70, H7:H70, J7:J70, L7:L70, N7:N70, P7:P70, R7:R70")) Is Nothing Then
        If Target <> "" And Target <> "vide" Then Ping_ordinateur Range(Target.Address)
    End If
End Sub

A+

 

[zergo]

Re : ping avec couleur vert pour ok et rouge ko

Merci Paf

Je te remercie un peux tardivement ca fonctionne très bien.


Merci encore.