arrondir valeur

Question

Bonjour à tous 
J'ai un tout petit problème je récupère une valeur d'un calcul par exemple 2,38 je voudrai arrondir la valeur à 2,5 
J'ai essayé de convertir les valeurs avec CSng ou encore CInt mais en vain 
Si une âme charitable peut m?aider merci d'avance

cs_yvesyves · Answer

Tu n'as qu'à creer une fonction : 

Private Sub Form_Load()
MsgBox (ArrondiPerso(2.38))
End Sub


Public Function ArrondiPerso(Number As Double) As Single
Dim MonDecimale As Double
MonDecimale = CDbl(Number - Int(Number))
Dim Resultat As Single
Select Case MonDecimale
Case Is > 0.75
Resultat = Int(Number) + 1
Case Is > 0.5
Resultat = Int(Number) + 0.75
Case Is > 0.25
Resultat = Int(Number) + 0.5
Case Is > 0
Resultat = Int(Number) + 0.25
End Select
ArrondiPerso = Resultat
End Function

mortalino · Answer

Salut, je ne sais pas si c'est la meilleure façon de procéder, mais je t'en propose une (ça m'aura occupé quelques minutes ) 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 Private Declare Function GetUserDefaultLCID Lib "kernel32" () As Long Enum eMode Inferior = 0 Superior = 1 Half = 2 End Enum Private Const LOCALE_SDECIMAL = &HE Public Property Get DecimalSeparator() As String Dim nLength As Long Dim nLocale As Long nLocale = GetUserDefaultLCID() nLength = GetLocaleInfo(nLocale, LOCALE_SDECIMAL, vbNullString, 0) - 1 DecimalSeparator = Space$(nLength) GetLocaleInfo nLocale, LOCALE_SDECIMAL, DecimalSeparator, nLength End Property Function RoundNumber(ByVal dValue As Double, Mode As eMode) As Double Dim vartemp As Integer If InStr(1, CStr(dValue), DecimalSeparator) Then Select Case Mode Case Inferior RoundNumber = CDbl(Mid$(dValue, 1, InStr(1, dValue, DecimalSeparator))) Case Superior RoundNumber = CDbl(Mid$(dValue, 1, InStr(1, dValue, DecimalSeparator))) + 1 Case Half vartemp = CInt(Right$(Round(dValue, 1), 1)) If vartemp < 3 Then RoundNumber = CDbl(Mid$(dValue, 1, InStr(1, dValue, DecimalSeparator))) ElseIf vartemp > 7 Then RoundNumber = CDbl(Mid$(dValue, 1, InStr(1, dValue, DecimalSeparator))) + 1 Else RoundNumber = CDbl(Mid$(dValue, 1, InStr(1, dValue, DecimalSeparator))) + 0.5 End If End Select Else RoundNumber = dValue End If End Function Sub test() Debug.Print RoundNumber(2, Inferior) Debug.Print RoundNumber(2, Superior) Debug.Print RoundNumber(2, Half) Debug.Print RoundNumber(2.3, Inferior) Debug.Print RoundNumber(2.3, Superior) Debug.Print RoundNumber(2.3, Half) Debug.Print RoundNumber(2.8, Inferior) Debug.Print RoundNumber(2.8, Superior) Debug.Print RoundNumber(2.8, Half) End Sub ~ [code.aspx?ID=39466 Mortalino] ~ Colorisation automatique @++ le mystérieux chevalier,"Provençal, le gaulois" Forum Office & VBA

cs_yvesyves · Answer

Ca arrondit la valeur a 0.25 près

mortalino · Answer

Arf..

bah voilà, je me suis fait ch**r pour rien, surtout avec mes Mid..
Bien vu le code, c'est une façon à laquelle je n'avais pas pensé

@++

le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA

cs_yvesyves · Answer

Salut Mortalino,
Désolé :S. J'ai une petite question. Pourrais tu m'expliquer ce qu'est GetLocalInfo, par curiosité. Merci à toi

cs_matth72 · Answer

merci de ta reponse sa fonction mais pas comme je voudrais 
vu que je suis pressé sa fera l'affaire 
encore merci
a+

cs_matth72 · Answer

desoler j'avais pas vu qu'il y avait tand de reponse en tout cas merci des infos a++

jmfmarques · Answer

Bonjour,


est-ce ce que tu souhaites ?N

Private Sub Command1_Click()
 Dim toto As Double
 toto = 1.22
 toto = Int(toto) + IIf((toto - Int(toto)) >= 0.25, 0.5, 0)
 MsgBox toto
End Sub

cs_matth72 · Answer

merci je vais travailler dessus 
a+

mortalino · Answer

salut YvesYves

En fait je ne manipule cet API le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA

cs_yvesyves · Answer

Ok Merci

mortalino · Answer

voici l'exemple d'API-guide Option Explicit Const LOCALE_USER_DEFAULT = &H400 Const LOCALE_SENGCOUNTRY = &H1002 ' English name of country Const LOCALE_SENGLANGUAGE = &H1001 ' English name of language Const LOCALE_SNATIVELANGNAME = &H4 ' native name of language Const LOCALE_SNATIVECTRYNAME = &H8 ' native name of country 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 Private Sub Form_Load() 'KPD-Team 2001 'URL: http://www.allapi.net/ 'E-Mail: KPDTeam@Allapi.net MsgBox "You live in " & GetInfo(LOCALE_SENGCOUNTRY) & " (" & GetInfo(LOCALE_SNATIVECTRYNAME) & ")," & vbCrLf & "and you speak " & GetInfo(LOCALE_SENGLANGUAGE) & " (" & GetInfo(LOCALE_SNATIVELANGNAME) & ").", vbInformation End Sub Public Function GetInfo(ByVal lInfo As Long) As String Dim Buffer As String, Ret As String Buffer = String$(256, 0) Ret = GetLocaleInfo(LOCALE_USER_DEFAULT, lInfo, Buffer, Len(Buffer)) If Ret > 0 Then GetInfo = Left$(Buffer, Ret - 1) Else GetInfo = "" End If End Function ~ [code.aspx?ID=39466 Mortalino] ~ Colorisation automatique @++ le mystérieux chevalier,"Provençal, le gaulois" Forum Office & VBA

cs_yvesyves · Answer

Ok je vois merci beaucoup.

Arrondir valeur

13 réponses

Votre réponse

Discussions similaires