Función Puntos Millares

tema enviado por ElPrimo en ASP
tema iniciado el 31/10/2007

Función que pone los puntos de millares y normaliza los decimales de un numero pasado por parametro.

Parametro num es el numero en cuestion (decimales con "," no con ".")

Parametro muestraDecimales. Si es > 0 muestra el numero de decimales que le indiquemos redondeados.

Si es = 0 no  muestra decimales.

Esta es la funcion:

 

Private Function ponMiles(num, muestraDecimales)
    Dim numTratar
    Dim posComa
    Dim posPunto
    Dim parteDecimal
    Dim parteEntera
   
    num = CStr(num)
    If IsNumeric(num) Then
        'response.write "NUM=" & num
        parteEntera = Fix(num)
        posComa = InStr(1, CStr(num), ",")
        If posComa > 0 Then
            parteDecimal = Mid(num, posComa + 1, Len(num))
        Else
            parteDecimal = 0
        End If
        
        'Ahora ponemos los puntos en la parte entera
        Dim contaDigitosParaPunto
        Dim numConPuntos
        Dim i
        Dim posUltimoPunto
        
        If Len(parteEntera) > 3 Then
            posUltimoPunto = 0
            For i = Len(parteEntera) To 0 Step -1
                contaDigitosParaPunto = contaDigitosParaPunto + 1
                If contaDigitosParaPunto = 3 Then
                    If i = 0 And posUltimoPunto < 3 Then
                        numConPuntos = Left(parteEntera, 2) & numConPuntos
                    Else
                        numConPuntos = "." & Mid(parteEntera, i, 3) & numConPuntos
                    End If
                   
                    posUltimoPunto = 2
                    contaDigitosParaPunto = 0
                End If
               
                If i = 0 And contaDigitosParaPunto < 3 And contaDigitosParaPunto > 0 Then
                    If CStr(Mid(parteEntera, 1, contaDigitosParaPunto - 1) & numConPuntos) = CStr(numConPuntos) Then
                        numConPuntos = Mid(numConPuntos, 2, Len(numConPuntos))
                    Else
                        numConPuntos = Mid(parteEntera, 1, contaDigitosParaPunto - 1) & numConPuntos
                    End If
                Else
                    numConPuntos = Mid(numConPuntos, 1, Len(numConPuntos))
                End If
            Next
        Else
            numConPuntos = parteEntera
        End If
       
        If muestraDecimales >= 1 Then
            Dim numTratarDecimalesRedondeo
            numTratarDecimalesRedondeo = "0," & parteDecimal
            posComa = InStr(1, CStr(Round(numTratarDecimalesRedondeo, muestraDecimales)), ",")
            If posComa > 0 Then
                parteDecimal = Mid(Round(numTratarDecimalesRedondeo, muestraDecimales), posComa + 1, Len(numTratarDecimalesRedondeo))
            Else
                parteDecimal = "00"
            End If
            ponMiles = numConPuntos & "," & parteDecimal
        Else
            ponMiles = numConPuntos
        End If
    Else
        ponMiles = num
    End If
End Function