Check format Adresse IP

[thombar]

Bonjour cher Forum,

Je chercher un script qui après lancement puisse me dire si la valeur dans une cellule est bien dans le format d'adresse IP universellement défini.

- Respecter le format obligatoire : xxx.xxx.xxx.xxx (sachant que le nombre de x dans entre chaque "." peut varier de 1 à 3), sinon messagebox = "erreur, recommencez !"

- Si il y a des espaces dans la cellule, les supprimer.

- Si il y a un zéro devant un chiffre, le supprimer, sauf s'il est seul.
(exemple : 155.025.0.45 doit se transformer en 155.25.0.45).


Pourriez-vous m'aider ? pleeeaasse ?

merci et bon week end

 

[Zon]

Salut,

Si j'ai bien compris ce que tu voulais testes ceci:

Sub Princ()
Dim Res, T, I&
T = Range([A1], [A65536].End(xlUp)).Value ' à adapter
For I = 1 To UBound(T)
Res = RepZero(T(I, 1))
If Res <> False Then T(I, 1) = Res
Next I
[A1].Resize(UBound(T)) = T
End Sub

Function RepZero(ByVal Chaine$)
Dim T, I As Byte, J As Byte, Temp$
Chaine = Replace(Chaine, " ", "")
T = Split(Chaine, ".") 'à partir de XL 2000, sinon splitzon97(chaine,".")
For I = 0 To 3
If IsNumeric(T(I)) Then
While InStr(T(I), 0) >= 1 And Len(T(I)) > 1
T(I) = Replace(T(I), 0, "", 1, 1)
Wend
J = J + 1
Temp = Temp & T(I) & "."
End If
Next I
RepZero = IIf(J = 4 And UBound(T) = 3, Left(Temp, Len(Temp) - 1), False)
End Function

Au cas où tu sois sous XL97

Function SplitZon97(ByVal Ch$, Sep$)
Dim Pos&, PosS&, T(), I&
Pos = 1
Do
PosS = InStr(Pos, Ch, Sep)
ReDim Preserve T(I)
On Error Resume Next
T(I) = Mid(Ch, Pos, PosS - Pos)
If Err <> 0 Then
Pos = Pos - 1
T(I) = Right(Ch, Len(Ch) - Pos)
Exit Do
End If
Pos = PosS + 1
I = I + 1
Loop While PosS > 0
SplitZon97 = T
End Function


A+++

 

[thombar]

Bonjour,

Merci pour cette réponse, mais... j'ai beaucoup de mal à faire fonctionner ce code..... (Type mistmatch sur Ubound, variable non définie sur Replace, etc...), et je suis plutôt novice...

Pour être plus précis, j'ai une cellule qui doit contenir une adresse IP (exemple : A1), il faut simplement que le format soit OK selon les critères définis ci-dessus...

PS : ce serait pas mal que le code soit compatible avec toutes les versions d'Excel actuellement utilisées....

Merci de votre aide

 

[Zon]

Salut,

Effectivement j'avais oublié de dire que Replace n'existe pas sous XL97. Voici le code testé sous XL97 et XL2003, avec un bogue corrigé dans repzero . Tu peux aussi utilisé en fonction de feuille de calcul Repzero pour tester une cellule. ex en B1 =repzero(a1).

Sub Princ()
Dim Res, T, I&
T = Range([A1], [A65536].End(xlUp)).Value ' à adapter
For I = 1 To UBound(T)
Res = RepZero(T(I, 1))
T(I, 1) = IIf(Res <> False, Res, "Erreur")
Next I
[B1].Resize(UBound(T)) = T
End Sub

Public Function RepZero(ByVal Chaine$)
Dim T, I As Byte, J As Byte, Temp$
Chaine = ReplaceZon97(Chaine, " ", "")
T = SplitZon97(Chaine, ".")
If UBound(T) <> 3 Then RepZero = False: Exit Function
For I = 0 To 3
If IsNumeric(T(I)) Then
While InStr(T(I), 0) >= 1 And Len(T(I)) > 1
T(I) = ReplaceZon97(T(I), 0, "", 1, 1)
Wend
J = J + 1
Temp = Temp & T(I) & "."
End If
Next I
RepZero = IIf(J = 4, Left(Temp, Len(Temp) - 1), False)
End Function

Function ReplaceZon97$(ByVal Chaine$, Ch$, ChRemp$, Optional Dep& = 1, _
Optional Compte& = -1, Optional Comp As Byte = 0)
Do
Dep = InStr(Dep, Chaine, Ch, Comp)
On Error Resume Next
Chaine = Left(Chaine, Dep - 1) & ChRemp & Right(Chaine, Len(Chaine) - (Dep + Len(Ch) - 1))
On Error GoTo 0
Compte = Compte - 1
Loop While Dep > 0 And Compte <> 0
ReplaceZon97 = Chaine
End Function

Function SplitZon97(ByVal Ch$, Sep$)
Dim Pos&, PosS&, T(), I&
Pos = 1
Do
PosS = InStr(Pos, Ch, Sep)
ReDim Preserve T(I)
On Error Resume Next
T(I) = Mid(Ch, Pos, PosS - Pos)
If Err <> 0 Then
Pos = Pos - 1
T(I) = Right(Ch, Len(Ch) - Pos)
Exit Do
End If
Pos = PosS + 1
I = I + 1
Loop While PosS > 0
SplitZon97 = T
End Function

Pour ce qui est de toutes les versions, j'espère que tu n'utilises pas Excel 4 ou 7 encore...voire sous MacOS.
Si tu rencontre des difficultés à le mettre en place, joins un petit fichier exemple.

A+++

 

[thombar]

Merci beaucoup, mais j'ai toujours un problème, certainement une mauvaise utilisation.... (voir le fichier ci-joint).

J'ai un Type Mistmatch qui me demande de corriger la ligne :
For I = 1 To UBound(T)

Petite précision d'importance : le format est xxx.xxx.xxx.xxx sachant que chaque xxx ne peut être qu'un nombre allant de 0 à 255.

Dans l'exemple, je ne fais la vérification que sur une seule cellule, ce qui est le cas pour ma macro (pas besoin de vérifier une colonne de données)

Merci encore de ton aide Zon !

 

[LaurentTBT]

Bonjour à tous,

J'ai essayé de faire différemment (la façon de programmer de Zon m'est assez complexe!)
Je pense avoir tout testé, mais tu sais mieux que moi ce qui peut encore coincer.
J'ai recréé comme Zon la fonction Replace (d'une autre manière), mais j'espère que InStr est disponible sous excel 97. Sinon, dis le moi, je la reprogrammerai.

à plus…

 

[thombar]

Bravo, cela fonctionne parfaitement !!
Je tire mon chapeau.

Merci aussi à Zon pour sa macro complexe , qui fonctionne très certainement bien aussi.

A bientôt

 

[Zon]

Salut,

Normal que cela fonctionne pas, je ne mets pas de gestion d'erreurs pour les tests, tu n'as rien dans ta colonne A.

Moi je vois rien de complexe il suffisait juste d'adapter Princ.
Sous 97 je suis bien obligé de reécrire Split et Replace.

Tu as rajouté une condition les valeurs de 0 à 255, j'ai modifié une ligne dans repzero.

Regardes dans le fichier joint, j'ai modifié on peut le faire en évènementielle c'est à dire une fois la valeur saisie dans A1 ça se fait tout seul.

A+++

 

[thombar]

Génial. Ca fonctionne très bien.

Désolé, Zon, je suis un peu novice en la matière, surtout pour des codes aussi élaborés....

Me voici donc avec deux solutions à mon problème !!
Merci beaucoup pour vos efforts !