[AC-2000] Garder n chiffres significatifs d'un montant

[ClaudeLELOUP]

Bonjour,

Ceci pour "généraliser" la réponse donnée ici :
http://www.developpez.net/forums/d97...x/#post5631453

Code :

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
Public Function GarderNChiffresSignificatifs(Montant As Double, NbreChiffres As Integer, _
                          Optional BorneSuperieure As Boolean) As Double
'   ex        ? GarderNChiffresSignificatifs(123456.789, 3,true)
Dim strValeurAbsolue As String, tblEntierDecimal() As String, i As Integer
Dim intPuissance As Integer, tblBornes(2) As Double, intInverserSigne As Integer
Dim Pas As Double
strValeurAbsolue = CStr(Abs(Montant))
tblEntierDecimal = Split(strValeurAbsolue, ",")
 If tblEntierDecimal(0) > 0 Then
          'Traitement si partie entière
     Pas = 10 ^ (Len(tblEntierDecimal(0)) - NbreChiffres)
     GoTo Arrondissage
     ''GarderNChiffresSignificatifs = ArrondirUnPrix(Montant, 10 ^ (Len(tblEntierDecimal(0)) - 3))
   Else
          'chercher le rang du 1er chiffre significatif
     For i = 1 To Len(tblEntierDecimal(1))
        If Mid(tblEntierDecimal(1), i, 1) <> "0" Then
           Pas = 10 ^ (-i - NbreChiffres + 1)
           GoTo Arrondissage
           Exit For
        End If
     Next i
 End If
 
Arrondissage:
If Montant > 0 Then intInverserSigne = 1 Else intInverserSigne = -1
Montant = Montant * intInverserSigne
tblBornes(0) = Int(Montant / Pas) * Pas
tblBornes(1) = tblBornes(0) + Pas
   'choix de la borne
If BorneSuperieure = False Then
    If Montant - tblBornes(0) <= tblBornes(1) - Montant Then  'choix du plus petit écart
          GarderNChiffresSignificatifs = tblBornes(0)                 'borne inf si équidistance
    Else
          GarderNChiffresSignificatifs = tblBornes(1)
    End If
Else
    If Montant - tblBornes(0) < tblBornes(1) - Montant Then  'choix du plus petit écart
          GarderNChiffresSignificatifs = tblBornes(0)                 'borne sup si équidistance
    Else
          GarderNChiffresSignificatifs = tblBornes(1)
    End If
 
End If
   'rétablir le signe
GarderNChiffresSignificatifs = GarderNChiffresSignificatifs * intInverserSigne
End Function