Format code postal

[Temjeh]

Bonjour et merci d'avance

Je cherche en VBA a tester si c'est le bon format dans mon inputbox.
Code postal du Canada

Toujours en majuscule avec espace au centre: H1N 2R3

up:
code = InputBox(prompt:="Entrer le code postal. Ex: H1N 2R3", Title:="New")

If Format(Code,... <> ... then Msgbox "Mauvais format": goto up:

Le majuscule n'est pas trop important car je peut mettre tout en maj à la fin du code

J'ai ceci que je pourrais mettre et tester chaque caractère. Mais si il y a mieux.
If IsNumeric(Left(code, 1)) Then MsgBox "Mauvais format": GoTo up
If Not IsNumeric(Left(code, 2)) Then MsgBox "Mauvais format": GoTo up

Aussi si vous l'avez en MFC pour exemple rouge si c'est pas ce format.

Merci de votre temps

Temjeh

 

[job75]

Re : Format code postal

Bonjour Temjeh,

Mes sources :

https://fr.wikipedia.org/wiki/Codes_postaux_canadiens

Placez dans un Module standard :

Sub CodePostal()
Dim code$
1 code = UCase(InputBox("Entrer le code postal. Ex: H1N 2R3", "New", code))
If code = "" Then Exit Sub
If ErreurCodePostal(code) Then MsgBox "Mauvais format": GoTo 1
'suite du code
End Sub

Function ErreurCodePostal(code$) As Boolean
If Len(code) <> 7 Then ErreurCodePostal = True: Exit Function
Dim exclu$, exclu1$, i As Byte, t$, a As Byte
exclu = "DFIOQU"
exclu1 = "WZ" 'pour le 1er caractère
For i = 1 To 7
  t = Mid(code, i, 1): a = Asc(t)
  Select Case i
    Case 1
      If a < 65 Or a > 90 Or InStr(exclu & exclu1, t) Then _
        ErreurCodePostal = True: Exit Function
    Case 2, 5, 7
      If Not t Like "#" Then ErreurCodePostal = True: Exit Function
    Case 3, 6
      If a < 65 Or a > 90 Or InStr(exclu, t) Then _
        ErreurCodePostal = True: Exit Function
    Case 4: If t <> " " Then ErreurCodePostal = True: Exit Function
  End Select
Next
End Function

La fonction ErreurCodePostal peut être utilisée dans une feuille de calcul ou dans une MFC.

A+

 

[Temjeh]

Re : Format code postal

WOW

Impeccable cette fonction

Très apprécié.

Si je la met en feuille "Base".

Comment l'adapter en MFC pour tester la colonne H ou il y a les codes postaux?

Merci

 

[job75]

Re : Format code postal

Re,

Je suis surpris par la question car c'est évident.

Sélectionner la colonne H et créer la MFC avec cette formule :

=(LIGNE()>1)*ErreurCodePostal(H1)

Sur version anglaise :

=(ROW()>1)*ErreurCodePostal(H1)

A+

 

[Temjeh]

Re : Format code postal

Merci

Assez simple mais ca ne fonctionne

J'ai copié juste la fonction dans le module de la feuille et
fait la MFC sur colonne H, mais fonctionne pas.

Temjeh

 

[job75]

Re : Format code postal

Re,

Bah cherchez l'erreur :

J'ai copié juste la fonction dans le module de la feuille (...)

Placez dans un Module standard : (...)

PS : la formule de la MFC que j'ai donnée colorera aussi les cellules vides.

Pour l'éviter utilisez plutôt :

=ET(LIGNE()>1;H1<>"";ErreurCodePostal(H1))

ou version anglaise :

=AND(ROW()>1,H1<>"",ErreurCodePostal(H1))

A+

 

[Temjeh]

Re : Format code postal

Merci beaucoup pour ton temps

J'ai trouvé l'erreur

Bizarre ...
Ta formule fonctionne sauf en H1, c'est pour cela qu'elle me semblait pas fonctionné

Pas grave, je garde celle-ci

A+

Temjeh

 

[job75]

Re : Format code postal

Re,

En H1 normalement on met un titre, c'est pourquoi il y a la condition LIGNE()>1

A+

 

[job75]

Re : Format code postal

Bonjour Temjeh, le forum,

Si l'on veut ignorer la casse dans la détermination des erreurs utiliser :

Option Compare Text 'pour ignorer la casse

Function ErreurCodePostal(code$) As Boolean
If Len(code) <> 7 Then ErreurCodePostal = True: Exit Function
Dim exclu$, exclu1$, i As Byte, t$
exclu = "DFIOQU"
exclu1 = "WZ" 'pour le 1er caractère
For i = 1 To 7
  t = Mid(code, i, 1)
  Select Case i
    Case 1
      If t < "A" Or t > "Z" Or InStr(exclu & exclu1, t) Then _
        ErreurCodePostal = True: Exit Function
    Case 2, 5, 7
      If Not t Like "#" Then ErreurCodePostal = True: Exit Function
    Case 3, 6
      If t < "A" Or t > "Z" Or InStr(exclu, t) Then _
        ErreurCodePostal = True: Exit Function
    Case 4: If t <> " " Then ErreurCodePostal = True: Exit Function
  End Select
Next
End Function

Bonne journée.