VB - Erreur Automation

Bonjour tout le monde,

J'ai un problème dans mon code VB qui quand il se lance, sur une ligne le code plante et j'ai une erreur automation puis mon fichier Excel plante

quand je test où le code plante c'est la ligne 83 juste après la Fonction IP_connect(hostname)

J'ai regardé un peu partout sans trouver de solution c'est pour cela que je demande votre aide

Voici le code que j'utilise

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 PtrSafe Function gethostbyname Lib _
"WSOCK32.DLL" (ByVal _
hostname As String) As Long
Private Declare PtrSafe Function WSAStartup Lib _
"WSOCK32.DLL" (ByVal wVersionRequired&, _
lpWSAData As WSADATA) As Long
Private Declare PtrSafe Function WSACleanup Lib "WSOCK32.DLL" _
() As Long
Private Declare PtrSafe Sub CopyMemory Lib "KERNEL32" _
Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, _
ByVal cbCopy As Long)
Private Declare PtrSafe Function IcmpCreateFile Lib "icmp.dll" _
() As Long
Private Declare PtrSafe Function IcmpCloseHandle Lib "icmp.dll" _
(ByVal HANDLE As Long) As Boolean
Private Declare PtrSafe 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 <------------------------------------------ BUG ICI
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 Address = 0 Then
IP_connect = "Résolution impossible le "
Else
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
IP_connect = "Timeout le "
End If

If EchoReply.Status = 0 Then
'IP_connect = "Ping OK vers " + HostName + " (" + rIP + ") délai " + Trim$(CStr(EchoReply.RoundTripTime)) + "ms"
IP_connect = "OK en " + Trim$(CStr(EchoReply.RoundTripTime)) + "ms le "
Else
IP_connect = "Echec le "
End If
End If
Call IcmpCloseHandle(hFile)
Call WSACleanup
End Function

Sub TestPing_Modif_Couleur_Texte_et_details_2_colonnes_a_droite()
Dim Sel As Range
Dim Cel As Range
Dim message
Set Sel = Selection
For Each Cel In Sel
'MsgBox (Right(Cel.Value, 2))
If Right(Cel.Value, 2) <> ".0" And Cel.Value <> "" Then
message = IP_connect(Cel.Value)
Select Case Left(message, 2)
Case "OK"
ActiveCell.Font.Color = -13369498 'vert
Case "Ti"
ActiveCell.Font.Color = -16727809 'orange
Case "Ré"
ActiveCell.Font.Color = -16776961 'rouge
Case "Ec"
ActiveCell.Font.Color = -16776961 'rouge
End Select

ActiveCell.Offset(0, 3) = message & Date & " " & Time
'ActiveCell.Offset(0, 3) = Date & " " & Time
End If
ActiveCell.Offset(1, 0).Range("A1").Select
Next Cel
Set Sel = Nothing
End Sub

J'ai trouvé le problème

il faut installer une version 32 bits de Excel

Bizarre ; j'allais dire exactement le contraire à la vue du codage

D'aprés la définition de microsoft : Le mot clé PtrSafe indique que l'instruction Declare peut être exécutée en toute sécurité dans des environnements de développement 64 bits.

Dans ce cas Etrange que ce code soit une une version 32bit ?