Convertir Cantidades Numerica a Letras Visual Net

#1
Que tal mis estimados y muy finos programadores, comparto con ustedes una función muy bonita para convertir nuestras cantidades numericas a letras, fácil de implementar en sus proyectos (OJO, Visual Basic NET)
La función necesita que le envien los siguientes párametros:

Call Dinero(1235.50,2,"Pesos",true)

Parámetro 1: Cantidad a convertir
Parámetro 2: Número de Decimales
Parámetro 3: Moneda
Parámetro 4: Despliega o no el rollo de MN al final de la conversión.




Public Function Dinero(ByVal Monto As Double, ByVal ncents As Integer, ByVal desmon As String, ByVal mn As Boolean)
Dim nmonto As Double
Dim acUnid(10) As String
Dim acDecY(10) As String
Dim acDec(10) As String
Dim acCent(10) As String
Dim acGrup(5) As String
Dim acGrp1(5) As String
Dim acEsp(10) As String
Dim masmen As String
Dim cRetVal As String
Dim cCant As String
Dim caux As String
Dim naux1 As String
Dim naux2 As String
Dim naux3 As String
Dim n As Integer
Dim cCents As Double
Dim sCents As String
Dim lGrpFlg As Boolean
Dim Moneda As String
Moneda = desmon
nmonto = Math.Abs(Monto)
masmen = IIf(Monto >= 0,
"", "Menos ")
acUnid(1) =
"Un "
acUnid(2) = "Dos "
acUnid(3) = "Tres "
acUnid(4) = "Cuatro "
acUnid(5) = "Cinco "
acUnid(6) = "Seis "
acUnid(7) = "Siete "
acUnid(8) = "Ocho "
acUnid(9) = "Nueve "
acDecY(1) = "Dieci"
acDecY(2) = "Veinti"
acDecY(3) = "Treinta y "
acDecY(4) = "Cuarenta y "
acDecY(5) = "Cincuenta y "
acDecY(6) = "Sesenta y "
acDecY(7) = "Setenta y "
acDecY(8) = "Ochenta y "
acDecY(9) = "Noventa y "
acDec(1) = "Diez "
acDec(2) = "Veinte "
acDec(3) = "Treinta "
acDec(4) = "Cuarenta "
acDec(5) = "Cincuenta "
acDec(6) = "Sesenta "
acDec(7) = "Setenta "
acDec(8) = "Ochenta "
acDec(9) = "Noventa "
acCent(1) = "Ciento "
acCent(2) = "Doscientos "
acCent(3) = "Trescientos "
acCent(4) = "Cuatrocientos "
acCent(5) = "Quinientos "
acCent(6) = "Seiscientos "
acCent(7) = "Setecientos "
acCent(8) = "Ochocientos "
acCent(9) = "Novecientos "
acGrup(1) = "Billones "
acGrup(2) = "Mil "
acGrup(3) = "Millones "
acGrup(4) = "Mil "
acGrp1(1) = "Bill¢n "
acGrp1(2) = "Mil "
acGrp1(3) = "Mill¢n "
acGrp1(4) = "Mil "
acEsp(1) = "Once "
acEsp(2) = "Doce "
acEsp(3) = "Trece "
acEsp(4) = "Catorce "
acEsp(5) = "Quince "
If Int(nmonto) = 0 Then
cRetVal = "Cero "
Else
cCant = Format(Int(nmonto), "000000000000000")
cRetVal = masmen
For n = 0 To 4
caux = Mid(cCant, 3 * n + 1, 3)
If caux = "100" Then
cRetVal = cRetVal & "Cien "
Else
naux1 = Asc(Left(caux, 1)) - 48
naux2 = Asc(Right(Left(caux, 2), 1)) - 48
naux3 = Asc(Right(caux, 1)) - 48
If naux1 <> 0 Then
cRetVal = cRetVal & acCent(naux1)
End If
If naux2 = 1 And (naux3 = 1 Or naux3 = 2 Or naux3 = 3 Or naux3 = 4 Or naux3 = 5) Then
cRetVal = cRetVal & acEsp(naux3)
Else
If naux3 = 0 Then
If naux2 <> 0 Then cRetVal = cRetVal & acDec(naux2)
Else
If naux2 <> 0 Then cRetVal = cRetVal & acDecY(naux2)
End If
cRetVal = cRetVal & acUnid(naux3)
End If
End If
If n < 4 Then
If caux = "000" Then
If lGrpFlg = True Then
cRetVal = cRetVal & acGrup(n + 1)
lGrpFlg =
False
End If
Else
If cRetVal = "Un " Then
cRetVal = cRetVal & acGrp1(n + 1)
Else
cRetVal = cRetVal & acGrup(n + 1)
End If
lGrpFlg = (n = 1 Or n = 3)
End If
End If
Next
End If
cRetVal = UCase(Left(cRetVal, 1)) & LCase(Mid(cRetVal, 2))
If ncents > 0 And ncents < 5 Then
cCents = nmonto - Int(nmonto)
sCents = Format(cCents * 100,
"00")
If Right(cRetVal, 4) = "l¢n " Or Right(cRetVal, 4) = "nes " Then cRetVal = cRetVal & "DE "
cRetVal = cRetVal & Moneda & " "
Select Case ncents
Case 1 : cRetVal = cRetVal & sCents & "/100"
Case 2 : cRetVal = cRetVal & "con " & sCents & "/100"
Case 3
If cCents = "00" Then
cRetVal = cRetVal & "Sin Centimos"
Else
cRetVal = cRetVal & "con " & sCents & " CENTIMOS"
End If
Case 4
If cCents = "00" Then
cRetVal = cRetVal & "Sin Centavos"
Else
cRetVal = cRetVal & "con " & sCents & " CENTAVOS"
End If
End Select
Else
cRetVal = cRetVal & Trim(cRetVal)
If cRetVal = "Un " Then cRetVal = "Uno"
End If
' Agregado de MN para el caso de moneda local
If mn And (UCase(desmon) = "Peso" Or UCase(desmon) = "PESOS") Then cRetVal = cRetVal & " M.N."
Dinero = cRetVal
End Function


:mota:
Saluds
 
Arriba