Texte NombreEnTxt

Magic_Doctor

XLDnaute Barbatruc
2 fonctions de job75 que j'ai fusionnées.
Transforme un nombre en chaîne de caractères. Tout est normalement bien expliqué dans l'intro de la fonction.
VB:
Function NombreEnTxt$(num As Variant, x As Byte, Optional sep As Boolean = True, Optional TypeSep$, Optional mas As Boolean = False)
'************************************************************************************************************************************
'Retranscrit un nombre en chaîne.
'Complète s'il le faut, avec des 0, un nombre décimal, de telle sorte qu'il y ait un nombre déterminé de chiffres après la virgule.
'Place éventuellement des séparateurs de milliers
'job75 / Magic_Doctor
'************************************************************************************************************************************
'- num     : un nombre
'- x       : le nombre de chiffres voulu après la virgule
'- sep     : si False --> pas de séparateur(s) de milliers
'            si True  --> séparateur(s) de milliers
'- TypeSep : si " " --> espace (25145785 --> 25 145 785)
'            si "." --> point  (25145785 --> 25.145.785)
'- mas     : si True : si le nombre est positif, alors il sera précédé du signe "+"
'Exemple   : si x = 2 & sep = True ou omis => num = 2               --> 2,00
'                                             num = 125752,22       --> 125.752,22
'                                             num = -202454524565,5 --> -202.454.524.565,50
'            si x = 5 | sep = True | TypeSep = " " | mas = True => num = 125365875,25 --> +125 365 875,25000

    Dim signe$, Txt$, i%, t$, n$, nb$, pos As Byte, gauche$, droite$, millier$

    On Error Resume Next 'pour que n'apparaisse pas #¡VALOR! si num = ""
    If num = "" Then Exit Function
    
    signe = IIf(num = Abs(num), IIf(mas, "+", ""), "-")
    
    num = FormatNumber(num, 15) 'pour éviter que ne s'impose la notation scientifique
    Txt = CStr(Abs(num))
    For i = 1 To Len(Txt)
        t = Mid(Txt, i, 1)
        If Not IsNumeric(t) And t <> "," And t <> "." Then Exit For
    Next
    t = Replace(Left(Txt, i - 1), ",", ".")
    n = IIf(i = 1, "", Format(Val(t), "0." & String(x, "0")))
    If x = 0 Then n = Replace(n, ",", "") 'pas de décimale après la virgule donc pas de virgule
    
    nb = n & Mid(Txt, i)
    pos = InStr(1, nb, ",")
    gauche = Left(nb, pos - 1)
    droite = Mid(nb, pos + 1)
    
    If x = 0 Then
        millier = IIf(TypeSep = " ", Replace(Format(Int(Abs(num)), "#,##0"), ".", Chr(160)), Replace(Format(Int(Abs(num)), "#,##0"), Chr(160), "."))
        NombreEnTxt = IIf(sep, signe & millier, signe & n)
    Else
        millier = IIf(TypeSep = " ", Replace(Format(CDec(gauche), "#,##0"), ".", Chr(160)), Replace(Format(CDec(gauche), "#,##0"), Chr(160), "."))
        If InStr(gauche, Application.DecimalSeparator) Then millier = millier & Mid(gauche, InStr(gauche, Application.DecimalSeparator))
        NombreEnTxt = IIf(sep, signe & millier & IIf(x = 0, "", ",") & droite, signe & n)
    End If
End Function
 

Magic_Doctor

XLDnaute Barbatruc
Quelques améliorations + simplification du paramétrage.
VB:
Function NombreEnTxt$(num As Variant, x As Byte, TypeSep$, Optional mas As Boolean = False)
'************************************************************************************************************************************
'Retranscrit un nombre en chaîne.
'Complète s'il le faut, avec des 0, un nombre décimal, de telle sorte qu'il y ait un nombre déterminé de chiffres après la virgule.
'Place éventuellement des séparateurs de milliers
'job75 / Magic_Doctor
'************************************************************************************************************************************
'- num     : un nombre
'- x       : le nombre de chiffres voulu après la virgule
'- TypeSep : si ""  --> pas de séparateurs de milliers (25145785 --> 25145785)
'            si " " --> espace (25145785 --> 25 145 785)
'            si "." --> point  (25145785 --> 25.145.785)
'- mas     : si True : si le nombre est positif, alors il sera précédé du signe "+"
'Exemple   : si x = 2 & sep = True ou omis => num = 2               --> 2,00
'                                             num = 125752,22       --> 125.752,22
'                                             num = -202454524565,5 --> -202.454.524.565,50
'            si x = 5 | sep = True | TypeSep = " " | mas = True => num = 125365875,25 --> +125 365 875,25000

    Dim signe$, Txt$, i%, t$, n$, nb$, pos As Byte, gauche$, droite$, millier$

    On Error Resume Next 'pour que n'apparaisse pas #¡VALOR! si num = ""
    If num = "" Then Exit Function
    
    signe = IIf(num = Abs(num), IIf(mas, "+", ""), "-")
    
    num = FormatNumber(num, 15) 'pour éviter que ne s'impose la notation scientifique
    Txt = CStr(Abs(num))
    For i = 1 To Len(Txt)
        t = Mid(Txt, i, 1)
        If Not IsNumeric(t) And t <> "," And t <> "." Then Exit For
    Next
    t = Replace(Left(Txt, i - 1), ",", ".")
    n = IIf(i = 1, "", Format(Val(t), "0." & String(x, "0")))
    If x = 0 Then n = Replace(n, ",", "") 'pas de décimale après la virgule donc pas de virgule
    
    nb = n & Mid(Txt, i)
    pos = InStr(1, nb, ",")
    gauche = Left(nb, pos - 1)
    droite = Mid(nb, pos + 1)
    
    If TypeSep = "" Then  'pas de séparateurs de milliers
        NombreEnTxt = signe & n
    Else  'séparateurs de milliers (" " ou ".")
        If x = 0 Then  'nombre entier
            millier = IIf(TypeSep = " ", Replace(Format(Int(Abs(num)), "#,##0"), ".", Chr(160)), Replace(Format(Int(Abs(num)), "#,##0"), Chr(160), "."))
            NombreEnTxt = signe & millier
        Else  'nombre décimal
            millier = IIf(TypeSep = " ", Replace(Format(CDec(gauche), "#,##0"), ".", Chr(160)), Replace(Format(CDec(gauche), "#,##0"), Chr(160), "."))
            If InStr(gauche, Application.DecimalSeparator) Then millier = millier & Mid(gauche, InStr(gauche, Application.DecimalSeparator))
            NombreEnTxt = signe & millier & "," & droite
        End If
    End If
End Function
 

Discussions similaires