1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100
|
Sub Vérif_Selection()
On Error Resume Next
Dim Rng As Range, cell As Range
Dim Tab_Ra As Range, objhttp As Variant, PingResult As Variant, Computer$, IP As String
'Dim cellCA As Range, cellEPO As Range, cellEPOM As Range
Dim Cell_CA As Variant, Cell_EPO As String, Cell_EPOM As String, Cell_Result As String
Set Rng = Selection
'Selection
'Range("E6898:E7255")
For Each cell In Rng
If cell.Offset(0, 20).Value = "Non" Then 'Valide si il sagit d'une exception
If cell.Offset(0, -4).Value = "" Or cell.Offset(0, -3).Value = "Poste Non Actif" Then 'Ping le poste
Computer$ = Trim(cell.Offset(0, -2).Value) & "PT": IP = ""
For Each PingResult In GetObject("winmgmts://./root/cimv2").ExecQuery _
("SELECT * FROM Win32_PingStatus WHERE Address = '" & Computer$ & "'")
If IsObject(PingResult) Then IP = PingResult.ProtocolAddress
Next
If IP = "" Then
cell.Offset(0, -4).Value = "X"
'cell.Offset(0, -3).Value = "Poste Non Actif"
Else: cell.Offset(0, -4).Value = "V"
End If
' IP
End If
If cell.Offset(0, -4) = "X" Then 'Si le résultat du ping est négatif
If cell = "06- RETIRÉ (SURPLUS)" Then
If cell.Offset(0, 2) < cell.Offset(0, 18) Then
cell.Offset(0, -5) = "À Supprimer"
cell.Offset(0, -3) = "Retiré, Non Actif"
Else
cell.Offset(0, -5) = "À Valider"
cell.Offset(0, -3) = "Retiré, actif"
End If
End If
If cell <> "07- RETIRÉ (CÉDÉ)" Or cell <> "08- RETIRÉ (REMPLACÉ GARANTIE)" Or cell <> "09- RETIRÉ (INTROUVABLE)" Or cell <> "10- RETIRÉ (SURPLUS À FAIRE)" Or cell <> "06- RETIRÉ (SURPLUS)" Then
If cell.Offset(0, 16) <> "Actif" Then 'Vérif Cell AD autre que Actif
If cell.Offset(0, -4).Value = "X" Then
cell.Offset(0, -5) = "À valider"
cell.Offset(0, -3) = "Inventaire, non actif" 'Inscription Si non actif et pas dans L'AD
Else
cell.Offset(0, -5) = "Conforme"
cell.Offset(0, -3) = "Inventaire, Actif, pas dans l'AD" 'Inscription actif et pas dans L'AD
End If
Else
If cell = "02- REÇU" Then
cell.Offset(0, -5) = "À valider"
cell.Offset(0, -3) = "Reçu, Actif"
ElseIf cell.Offset(0, -1) = "NULL" Then 'Vérif CA14 à NULL
If cell.Offset(0, -4).Value = "X" Then 'Pas de Ping
cell.Offset(0, -5) = "À valider"
cell.Offset(0, -3) = "Inventaire, pas actif, pas dans CA" 'Inscription Si AD non Actif et CA14 NULL
Else
cell.Offset(0, -5) = "À valider"
cell.Offset(0, -3) = "Inventaire, actif, pas dans CA" 'Inscription Si AD Actif et CA14 NULL
End If
Else
If cell.Offset(0, 15) < Now() - 90 Then 'Vérif EPO 3 dernier mois
cell.Offset(0, -5) = "À valider"
cell.Offset(0, -3) = "Inventaire, non actif, pas com EPO"
Else
cell.Offset(0, -5) = "À valider"
cell.Offset(0, -3) = "Inventaire, actif, pas com EPO"
End If
End If
End If
End If
If cell = "07- RETIRÉ (CÉDÉ)" Or cell = "08- RETIRÉ (REMPLACÉ GARANTIE)" Or cell = "09- RETIRÉ (INTROUVABLE)" Or cell = "10- RETIRÉ (SURPLUS À FAIRE)" Then
If cell.Offset(0, 18) = "NULL" Then
cell.Offset(0, -5) = "À Supprimer"
cell.Offset(0, -3) = "Retiré, Non Actif"
ElseIf cell.Offset(0, 18) < Now() - 180 Then
cell.Offset(0, -5) = "À Supprimer"
cell.Offset(0, -3) = "Retiré, Non Actif"
Else
cell.Offset(0, -5) = "À valider"
cell.Offset(0, -3) = "Retiré, actif les 6 dernier mois"
End If
End If
Else
If cell = "06- RETIRÉ (SURPLUS)" Then
cell.Offset(0, -5) = "À valider"
cell.Offset(0, -3) = "Retiré, Actif"
End If
If cell = "06- RETIRÉ (CÉDÉ)" Or cell = "06- RETIRÉ (REMPLACÉ GARANTIE)" Or cell = "06- RETIRÉ (INTROUVABLE)" Or cell = "06- RETIRÉ (SURPLUS À FAIRE)" Then
cell.Offset(0, -5) = "À valider"
cell.Offset(0, -3) = "Retiré, Actif"
End If
End If
Else
cell.Offset(0, -3) = "Exception"
cell.Offset(0, -5) = "À valider"
End If
Next cell
Set objhttp = Nothing
End Sub |
Partager