Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Rédacteur/Modérateur
    Avatar de ProgElecT
    Homme Profil pro
    Retraité
    Inscrit en
    décembre 2004
    Messages
    4 898
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 63
    Localisation : France, Haute Savoie (Rhône Alpes)

    Informations professionnelles :
    Activité : Retraité
    Secteur : Communication - Médias

    Informations forums :
    Inscription : décembre 2004
    Messages : 4 898
    Points : 11 027
    Points
    11 027

    Par défaut Amélioration de la fonction FormatNumber

    Salut

    Non je n'ai pas réinventé la roue, en tout cas j’espère

    Il n'est pas évidant de traiter des entrées numériques, qu'elle proviennent d'une entrée utilisateur, d'une base de données ou d'un capteur quelconque.
    La fonction native FormatNumber() ne permet pas toujours de prendre en compte tous les cas de figure.

    La fonction proposée permet de prendre en considération beaucoup plus.
    L'entrée à traiter peut être un/des espaces, un vbNull, un vbNullChar, un vbnullString, une virgule ou toutes autres entrées non numérique,
    le retour de la fonction sera toujours un chiffre typé String.

    J'ai choisi un retour String, car cette fonction était destinée surtout à un affichage, non pas à un calcul.
    La fonction Val(), avec décimale(s) nécessite un Point, le retour de la fonction est donc adaptée.
    La fonction n’arrondit pas le chiffre à décimale, elle tronque la partie décimale au nombre paramétré dans son appel.

    Sur un Form,
    2 Label (Label1 et LabCaractMax)
    3 TextBox (Textdecimal, TextEntrer et TextRersult)
    1 CheckBox (CheckCallage)
    et ce
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
     Option Explicit
    Dim NbrCaract As Integer ' pour calcul du nombre d'espace pour un calage à droite d'un conteneur qui n'a pas de propriété .Alignement
    Dim Cpt As Integer ' divers boucles
     
     
    Private Sub Form_Load()
    Label1.Caption = "Nbr. de dec. :": Label1.Move 120, 120, 975, 195
    With Textdecimal ' pour le choix du nombre de décimale
        .Text = "0": .Alignment = 2: .Appearance = 0: .Move 1140, 60, 435, 285
    End With
    With CheckCallage ' pour un calage à droite ou non
        .Caption = "callage à droite": .Value = 0: .Move 1740, 60, 1755, 315
    End With
    With TextEntrer ' pour les essais
        .Appearance = 0
        .BorderStyle = 1
        .BackColor = &H80C0FF
        .Text = ""
        .FontName = "Courier New": .FontBold = True: .FontSize = 14
        .Move 120, 480, 3435, 450
    End With
     
    With TextRersult ' pour l'affichage après passage de la fonction FormatStr
        .Text = "": .Appearance = 0: .BorderStyle = 1: .FontName = "Courier New": .Move 120, 960, 3435, 435
    End With
    With LabCaractMax ' témoin pour la grandeur de décalage à droite
        .Appearance = TextRersult.Appearance
        .BorderStyle = TextRersult.BorderStyle
        .FontName = TextRersult.FontName
        .FontBold = TextRersult.FontBold
        .FontSize = TextRersult.FontSize
        .AutoSize = True
        .Move 120, 1440
        For Cpt = 1 To 50
            .Caption = String(Cpt, " ")
            If .Width >= TextRersult.Width Then NbrCaract = Cpt - 1: Exit For
        Next Cpt
    End With
    Form1.BorderStyle = 1: Form1.Caption = "Étude formatage chiffre"
    Me.Height = 2310: Me.Width = 3765
    End Sub
     
    Private Sub TextEntrer_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
        Case 44: KeyAscii = 46 'transforme la virgule en point
        Case 8, 13, 46, 48 To 57 ' les touches RET.ARR, Entrer, virgule et les chiffres sont autorisés
        Case Else: KeyAscii = 0: Exit Sub 'toutes autres touches sont annulées
    End Select
     
    If KeyAscii = 46 And InStr(1, TextEntrer.Text, ".", vbTextCompare) Then
        'déclenchement sur 2éme séparateur décimale, supprime le dernier entré et qui la sub
        KeyAscii = 0: Beep: Exit Sub
    End If
     
    If KeyAscii = vbKeyReturn Then ' l'entrée a été validée
        KeyAscii = 0 'supprime le ENTER
        If Trim(TextEntrer.Text) = "" Then MsgBox "vous devez entrer un nombre", vbInformation, "Erreur": Exit Sub
        '************************** Exemple d'utilisation de la fonction FormatStr *************************************
        TextRersult.Text = "" ' efface le contrôle conteneur d'affichage de la sortie
        If Textdecimal.Text = "" Then Textdecimal.Text = "0"
        If CheckCallage.Value = 0 Then
            '-------------- le chiffre est un entier ------------------------------------------
            '*** Exemple d'appel pour faire un affichage sans calcul ***
            TextRersult.Text = FormatStr(TextEntrer.Text, Textdecimal.Text)
            '*** Exemple d'appel pour faire un calcul ***
            'TextRersult.Text = Val(FormatStr(TextEntrer.Text, Textdecimal.Text)) + 15
            Else
            '-------------- le chiffre est un entier avec décimale(s) -------------------------
            '*** Exemple d'appel pour faire un affichage sans calcul ***
            'TextRersult.Text = FormatStr(TextEntrer.Text, Textdecimal.Text, NbrCaract)
            '*** Exemple d'appel pour faire un calcul, NbrCaract ne sera pas pris en compte ***
            TextRersult.Text = Val(FormatStr(TextEntrer.Text, Textdecimal.Text, NbrCaract)) + 15
            'donc en plus court
            'TextRersult.Text = Val(FormatStr(TextEntrer.Text, Textdecimal.Text)) + 15
        End If
    End If
    End Sub
     
    Function FormatStr(Valeur As Variant, Optional NbrDecimale As Integer = 0, Optional NbrCaractConteneur As Integer = 0) As String
    Dim T As Integer, PoS As Integer ' pour la boucle, pour position (utilisé dans la fonction  InStr())
    Dim EntierStr As String, DecimalStr As String ' partie entière, partie décimale
     
    '*-*-*-*-* Utile si la donnée "Valeur" provient par exemple d'une Base de données ou lecture d'un automatisme
    'en bref n'est pas un chiffre
    If Valeur = vbNull Or Valeur = vbNullChar Or Valeur = vbNullString Then Valeur = 0 '*-*-*-*-*
    If Trim(FormatStr) = "" Then FormatStr = "0" '*-*-*-*-*
     
    FormatStr = CStr(Valeur) 'force la variable d'entrée en String
    FormatStr = Replace(FormatStr, " ", "") '*-*-*-*-*
    FormatStr = Replace(FormatStr, ",", ".") '*-*-*-*-*
    FormatStr = Trim(FormatStr) 'supprime les éventuels espaces à gauche et à droite '*-*-*-*-*
     
    FormatStr = Val(FormatStr) ' extraction du chiffre, si juste un point ou non un chiffre, FormatStr = "0"
    If FormatStr = "0" Then If NbrDecimale <> 0 Then FormatStr = "0." & String(NbrDecimale, "0")
     
    FormatStr = Replace(FormatStr, ",", ".") 'Val() peut avoir transformé le point en virgule suivant le séparateur système
     
    PoS = InStr(1, FormatStr, ".", vbTextCompare) ' vérification de la position du point décimale
    If PoS <> 0 Then
        EntierStr = Left(FormatStr, PoS - 1) 'récupère la partie entière
        For T = 1 To Len(EntierStr) ' élimine les zéro non significatif de la partie entière
            If Mid(EntierStr, T, 1) = "0" Then EntierStr = Right(EntierStr, 1) Else Exit For
        Next T
        If EntierStr = "" Then EntierStr = "0"
        DecimalStr = Right(FormatStr, Len(FormatStr) - PoS) 'récupère la partie décimale
        If Len(DecimalStr) > NbrDecimale Then DecimalStr = Left(DecimalStr, NbrDecimale) ' ajout de zéro à la partie décimale
        Else
        EntierStr = FormatStr ' "Valeur" est un entier
    End If
    If NbrDecimale = 0 Then FormatStr = EntierStr Else FormatStr = EntierStr & "." & DecimalStr
     
    FormatStr = StrReverse(FormatStr) ' retourne le chiffre pour avoir les décimales à gauche
    PoS = InStr(1, FormatStr, ".", vbTextCompare) ' vérification de la position du point décimale
    'PoS, pour 1 décimales devrait être égal à 2, pour 2 décimales, devrait être égal à 3, pour 3 décimales, devrait être égal à 4 .....
    If NbrDecimale <> 0 Then 'ajoute éventuellement les décimales pour être égal à NbrDecimale
        If PoS <= NbrDecimale Then FormatStr = String((NbrDecimale + 1) - PoS, "0") & FormatStr
    End If
    FormatStr = StrReverse(FormatStr) ' retourne le chiffre
     
    'Formatage, purement pour l'affichage à gauche
    If NbrCaractConteneur <> 0 Then
        'formatage avec déplacement du chiffre vers la droite suivant le NbrCaract max du contrôle conteneur
        If NbrCaractConteneur >= Len(FormatStr) Then
            FormatStr = String(NbrCaractConteneur - Len(FormatStr), " ") & FormatStr
        End If
    End If
    End Function
    Ou le fichier projet:
    Fichiers attachés Fichiers attachés
    ProgElecT
    Soyez sympa, pensez -y
    Balises[CODE]...[/CODE]
    Balises[CODE=NomDuLangage]...[/CODE] quand vous mettez du code d'un autre langage que celui du forum ou vous postez.
    Le bouton en fin de discussion, quand vous avez obtenu l'aide attendue.
    ......... et pourquoi pas, pour remercier, un pour celui/ceux qui vous ont dépannés.

Discussions similaires

  1. Amélioration d'une fonction upload
    Par chpe1 dans le forum GD
    Réponses: 14
    Dernier message: 21/07/2015, 17h03
  2. [Toutes versions] amélioration d'une fonction pour trouver la lettre de la colonne
    Par illight dans le forum Macros et VBA Excel
    Réponses: 14
    Dernier message: 16/12/2013, 15h48
  3. [PHP 5.3] Amélioration d'une fonction de formatage
    Par General_Batton dans le forum Fonctions
    Réponses: 2
    Dernier message: 16/10/2012, 08h45
  4. [DOM] Amélioration d'un fonction pour la taille des polices
    Par boutmos dans le forum Général JavaScript
    Réponses: 12
    Dernier message: 20/08/2008, 11h34
  5. Améliorer ma fonction en passant en vectoriel
    Par progfou dans le forum Images
    Réponses: 1
    Dernier message: 22/10/2006, 21h58

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo