Cette démo explicite une routine permettant d'afficher des valeurs numériques quel que soit leur symbole décimal et elle explique comment une saisie peut être testée et convertie dans la configuration des paramètres régionaux et linguistiques de l'utilisateur.
Source / Exemple :
Option Explicit
Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Dim Chemin As String
Dim SymboleTouche As String, SymboleConfigureEnClair As String
'
Private Sub Form_Load()
Dim Retour As String * 2
Dim Rep As Long
On Error GoTo Erreur
Label1.Caption = "Problématique : Trois fichiers séquentiels en mode texte sont présents dans le répertoire courant. FichierP.txt contient une série de 10 nombres décimaux avec un point comme symbole décimal. FichierV.txt contient les 10 mêmes nombres avec une virgule comme symbole décimal. FichierMixte.txt comporte des valeurs comportant indifféremment point ou virgule. Trois ListBox doivent afficher correctement chacun des contenus. Une tentative de saisie mixte complète le test."
Chemin = App.Path
If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
Rep = GetLocaleInfo(&H400, &HE, Retour, Len(Retour)) ' Symbole décimal system
SymboleTouche = Left(Retour, Rep - 1)
If SymboleTouche = "." Then
SymboleConfigureEnClair = "le Point"
ElseIf SymboleTouche = "," Then
SymboleConfigureEnClair = "la Virgule"
End If
Exit Sub
Erreur:
MsgBox "Erreur N° " & Err & " - " & Err.Description, vbCritical + vbOKOnly, "Erreur à l'ouverture"
End Sub
'
Private Sub Command1_GotFocus()
' Balayette sur les listes
List1.Clear: List2.Clear: List3.Clear
End Sub
'
Private Sub Command1_Click()
' Ouvrir Fichiers
Dim Ligne As String
Dim Marge As String
On Error GoTo Erreur
Close #1
Open Chemin & "FichierP.txt" For Input As #1
Close #2
Open Chemin & "FichierV.txt" For Input As #2
Close #3
Open Chemin & "FichierMixte.txt" For Input As #3
Do Until EOF(1)
Line Input #1, Ligne
Ligne = SymboleDecimal(Ligne)
Select Case Int(Val(Ligne))
Case Is < 10: Marge = Space(6)
Case Is < 100: Marge = Space(6)
Case Is < 1000: Marge = Space(4)
Case Is < 10000: Marge = Space(2)
End Select
List1.AddItem Marge & Format(Val(Ligne), "00.00")
Loop
Do Until EOF(2)
Line Input #2, Ligne
Ligne = SymboleDecimal(Ligne)
Select Case Int(Val(Ligne))
Case Is < 10: Marge = Space(6)
Case Is < 100: Marge = Space(6)
Case Is < 1000: Marge = Space(4)
Case Is < 10000: Marge = Space(2)
End Select
List2.AddItem Marge & Format(Val(Ligne), "00.00")
Loop
Do Until EOF(3)
Line Input #3, Ligne
Ligne = SymboleDecimal(Ligne)
Select Case Int(Val(Ligne))
Case Is < 10: Marge = Space(6)
Case Is < 100: Marge = Space(6)
Case Is < 1000: Marge = Space(4)
Case Is < 10000: Marge = Space(2)
End Select
List3.AddItem Marge & Format(Val(Ligne), "00.00")
Loop
Close
Command2.SetFocus
Exit Sub
Erreur:
If Err = 53 Then
MsgBox "Fichier introuvable. - Trois fichiers doivent se trouver dans l'espace de travail : " & vbCrLf _
& "FichierP.txt , FichierV.txt, FichierMixe.txt"
Exit Sub
End If
MsgBox Err & " " & Err.Description
End Sub
'
Private Sub LireBits()
' Lire les symboles linguistiques et paramètres régionaux.
Dim FormatDate As String
Dim SeparateurHoraire As String
Dim SeparateurEnClair As String
Dim FormatDateLongue As String
Dim Pays As String, Langue As String, Monnaie As String, Devise As String
Dim Tampon As String * 30 ' Place 30 codes ASCII 0
Dim Rep As Long
Rep = GetLocaleInfo(&H400, &H8, Tampon, Len(Tampon))
Pays = Left(Tampon, Rep - 1)
Rep = GetLocaleInfo(&H400, &H4, Tampon, Len(Tampon)) ' Langue
Langue = Left(Tampon, Rep - 1)
Rep = GetLocaleInfo(&H400, &H14, Tampon, Len(Tampon)) ' Monnaie
Monnaie = Left(Tampon, Rep - 1)
Rep = GetLocaleInfo(&H400, &H15, Tampon, Len(Tampon)) ' Devise
Devise = Left(Tampon, Rep - 1)
Rep = GetLocaleInfo(&H400, &H1F, Tampon, Len(Tampon)) ' Format Date
FormatDate = Left(Tampon, Rep - 1)
Rep = GetLocaleInfo(&H400, &H1E, Tampon, Len(Tampon)) ' SeparateurHoraire
SeparateurHoraire = Left(Tampon, Rep - 1)
If SeparateurHoraire = ":" Then
SeparateurEnClair = "Deux points :"
ElseIf SeparateurHoraire = "/" Then
SeparateurEnClair = "Barre /"
End If
Rep = GetLocaleInfo(&H400, &H20, Tampon, Len(Tampon)) ' Date Longue
FormatDateLongue = Left(Tampon, Rep - 1)
Label5.Caption = "Vous vivez en " & Pays & " et vous parlez le " & Langue & "."
Label6.Caption = "Votre Symbole décimal est : " & SymboleConfigureEnClair
Label9.Caption = "Votre Symbole monétaire est : " & Monnaie & " " & Devise
Label10.Caption = "Expression du Format de la Date : " & FormatDate & vbCrLf & " Séparateur Horaire " & SeparateurEnClair _
& vbCrLf & vbCrLf & " Nous sommes le : " & Format(Date, FormatDateLongue) _
& vbCrLf & Date & " - Il est " & Time
End Sub
'
Private Sub Command2_Click()
' Lire les paramètres régionaux et luiguistiques
LireBits
Text1.Text = Empty
Text1.SetFocus
End Sub
'
Private Sub Command3_Click()
' Quitter
Dim Reponse As Long
Reponse = MsgBox("Voulez-vous vaiment quitter ce Programme ?", vbQuestion + vbYesNo, "Quitter le Programme ?")
If Reponse = vbYes Then
Unload Me
End
Else
Command1.SetFocus
Exit Sub
End If
End Sub
'
Private Function SymboleDecimal(LigneRecuperee As String)
' Conversion
Do While SymboleTouche = "."
LigneRecuperee = Replace(LigneRecuperee, ",", ".")
SymboleDecimal = LigneRecuperee
Exit Do
Loop
Do While SymboleTouche = ","
LigneRecuperee = Replace(LigneRecuperee, ".", ",")
SymboleDecimal = LigneRecuperee
Exit Do
Loop
End Function
'
Private Sub Text1_KeyPress(KeyAscii As Integer)
Const Tipe As String = "Double précision."
If KeyAscii = 13 Then
If Text1.Text = Empty Then
MsgBox "Aucune saisie - Revoir", vbOKOnly + vbCritical, " Chaîne vide."
Text1.SetFocus: Exit Sub
ElseIf IsNumeric(SymboleDecimal(Text1.Text)) = False Then
MsgBox "La saisie comporte des caractères non numériques ou parasitaires : " & Text1.Text & vbCrLf & "Revoir", vbOKOnly + vbCritical, " Valeur non numérique détectée."
Text1.SetFocus
Text1.SelStart = vbKeyEnd
Exit Sub
End If
Label2 = " Vous avez indiqué une valeur numérique : " & Format(SymboleDecimal(Text1.Text), "0.00") & " de Type : " & Tipe & "."
Command3.SetFocus
End If
End Sub
Conclusion :
Plus de plantages dus aux paramètres régionaux et linguistiques.
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.