• Lunes 23 de Diciembre de 2024, 03:30

Autor Tema:  Cantidad (dinero) a letra (Solucionado)  (Leído 31722 veces)

carlosespinoza

  • Miembro activo
  • **
  • Mensajes: 53
  • Nacionalidad: mx
    • Ver Perfil
    • http://carlostusa.spaces.live.com/
Cantidad (dinero) a letra (Solucionado)
« en: Jueves 28 de Mayo de 2009, 19:08 »
0
Hola a todos, de casualidad alguien conoce un buen algoritmo que convierta una cantidad (dinero) a letra?

Ejem:

78540.25=(Setenta y ocho mil quinietos cuarenta pesos 25/100 MN)

Esto es para una factura, entonces tiene que contemplar los centavos.

Por cierto, soy de Mexico por eso el MN...

Saludos y espero me puedan ayudar....  :comp:
« última modificación: Martes 9 de Junio de 2009, 15:55 por carlosespinoza »

lair

  • Miembro MUY activo
  • ***
  • Mensajes: 213
  • Nacionalidad: mx
    • Ver Perfil
Re: Cantidad (dinero) a letra
« Respuesta #1 en: Lunes 8 de Junio de 2009, 22:52 »
0
esta es una funcion en VB, esta en el mismo foro checala talvez te sirva suerte

http://www.solocodigo.com/index.php?opt=viewitem&id=571&type=1&node=1

carlosespinoza

  • Miembro activo
  • **
  • Mensajes: 53
  • Nacionalidad: mx
    • Ver Perfil
    • http://carlostusa.spaces.live.com/
Re: Cantidad (dinero) a letra
« Respuesta #2 en: Martes 9 de Junio de 2009, 15:54 »
0
Hola, gracias por la respuesta...

Pero hace 2 dias encontre una función y la adecue...

Por si a alguien le sirve:

Código: vb.net
  1.  
  2.  
  3.  
  4.     Private Const DOT As String = "."
  5.  
  6.     Public Function NumerosEnPalabras( _
  7.         ByVal Number As String, _
  8.         ByVal Moneda As String) As String
  9.  
  10.         Dim s As String
  11.  
  12.         Dim DecimalPlace As Integer
  13.  
  14.         Dim IntPart As String
  15.  
  16.         Dim Cents As String
  17.  
  18.         s = Format(Val(Number), "0.00")
  19.  
  20.         DecimalPlace = InStr(s, DOT)
  21.  
  22.         If DecimalPlace Then
  23.  
  24.             IntPart = Left(s, DecimalPlace - 1)
  25.  
  26.             'Cents = Left(Mid(s, DecimalPlace + 1, 2), 2)
  27.             Cents = Number.Substring(DecimalPlace, 2)
  28.         Else
  29.  
  30.             IntPart = s
  31.  
  32.             Cents = ""
  33.  
  34.         End If
  35.  
  36.         If IntPart = "0" Or IntPart = "" Then
  37.  
  38.             s = "Cero "
  39.  
  40.         ElseIf Len(IntPart) > 7 Then
  41.  
  42.             s = IntNumToSpanish(Val(Left(IntPart, Len(IntPart) - 6))) + _
  43.                 "Millones " + IntNumToSpanish(Val(Right(IntPart, 6)))
  44.  
  45.         Else
  46.  
  47.             s = IntNumToSpanish(Val(IntPart))
  48.  
  49.         End If
  50.  
  51.         If Right(s, 9) = "Millones " Or Right(s, 7) = "Millón " Then
  52.  
  53.             s = s + "de "
  54.         End If
  55.  
  56.         Select Case s
  57.  
  58.             Case "Un ", "Una "
  59.  
  60.                 s = s & Singular(Moneda)
  61.  
  62.             Case Else
  63.  
  64.                 s = s & Moneda
  65.  
  66.         End Select
  67.  
  68.         s = s & " "
  69.  
  70.         If Val(Cents) Then
  71.  
  72.             'Cents = "con " + IntNumToSpanish(Val(Cents)) + "Centavos"
  73.             Cents = Cents.Substring(0, 2) & "/100 M.N.)"
  74.         Else
  75.  
  76.             Cents = "00/100 M.N.)"
  77.  
  78.         End If
  79.  
  80.         Return ("(" & Trim(s + Cents).ToUpper)
  81.  
  82.     End Function
  83.  
  84.     Public Function IntNumToSpanish(ByVal numero As Integer) As String
  85.  
  86.         Dim ptr As Integer
  87.  
  88.         Dim n As Integer
  89.  
  90.         Dim i As Integer
  91.  
  92.         Dim s As String
  93.  
  94.         Dim rtn As String
  95.  
  96.         Dim tem As String
  97.  
  98.         s = CStr(numero)
  99.  
  100.         n = Len(s)
  101.  
  102.         tem = ""
  103.  
  104.         i = n
  105.  
  106.         Do Until i = 0
  107.  
  108.             tem = EvalPart(Val(Mid(s, n - i + 1, 1) + CloneChain(i - 1, "0")))
  109.  
  110.             If Not tem = "Cero" Then
  111.  
  112.                 rtn = rtn + tem + " "
  113.  
  114.             End If
  115.  
  116.             i = i - 1
  117.  
  118.         Loop
  119.  
  120.         '//Filters
  121.  
  122.         '//filterThousands
  123.  
  124.         ReplaceAll(rtn, " Mil Mil", " Un Mil")
  125.  
  126.         Do
  127.  
  128.             ptr = InStr(rtn, "Mil ")
  129.  
  130.             If ptr Then
  131.  
  132.                 If InStr(ptr + 1, rtn, "Mil ") Then
  133.  
  134.                     ReplaceStringFrom(rtn, "Mil ", "", ptr)
  135.  
  136.                 Else : Exit Do
  137.  
  138.                 End If
  139.  
  140.             Else : Exit Do
  141.  
  142.             End If
  143.  
  144.         Loop
  145.  
  146.         '//filterHundreds
  147.  
  148.         ptr = 0
  149.  
  150.         Do
  151.  
  152.             ptr = InStr(ptr + 1, rtn, "Cien ")
  153.  
  154.             If ptr Then
  155.  
  156.                 tem = Left(Mid(rtn, ptr + 5), 1)
  157.  
  158.                 If tem = "M" Or tem = "" Then
  159.  
  160.                 Else
  161.  
  162.                     ReplaceStringFrom(rtn, "Cien", "Ciento", ptr)
  163.  
  164.                 End If
  165.  
  166.             End If
  167.  
  168.         Loop Until ptr = 0
  169.  
  170.         '//filterMisc
  171.  
  172.         ReplaceAll(rtn, "Diez Un", "Once")
  173.  
  174.         ReplaceAll(rtn, "Diez Dos", "Doce")
  175.  
  176.         ReplaceAll(rtn, "Diez Tres", "Trece")
  177.  
  178.         ReplaceAll(rtn, "Diez Cuatro", "Catorce")
  179.  
  180.         ReplaceAll(rtn, "Diez Cinco", "Quince")
  181.  
  182.         ReplaceAll(rtn, "Diez Seis", "Dieciseis")
  183.  
  184.         ReplaceAll(rtn, "Diez Siete", "Diecisiete")
  185.  
  186.         ReplaceAll(rtn, "Diez Ocho", "Dieciocho")
  187.  
  188.         ReplaceAll(rtn, "Diez Nueve", "Diecinueve")
  189.  
  190.         ReplaceAll(rtn, "Veinte Un", "Veintiun")
  191.  
  192.         ReplaceAll(rtn, "Veinte Dos", "Veintidos")
  193.  
  194.         ReplaceAll(rtn, "Veinte Tres", "Veintitres")
  195.  
  196.         ReplaceAll(rtn, "Veinte Cuatro", "Veinticuatro")
  197.  
  198.         ReplaceAll(rtn, "Veinte Cinco", "Veinticinco")
  199.  
  200.         ReplaceAll(rtn, "Veinte Seis", "Veintiseís")
  201.  
  202.         ReplaceAll(rtn, "Veinte Siete", "Veintisiete")
  203.  
  204.         ReplaceAll(rtn, "Veinte Ocho", "Veintiocho")
  205.  
  206.         ReplaceAll(rtn, "Veinte Nueve", "Veintinueve")
  207.  
  208.         '//filterOne
  209.  
  210.         If Left(rtn, 1) = "M" Then
  211.  
  212.             rtn = "Un " + rtn
  213.  
  214.         End If
  215.  
  216.         '//Un Mil...
  217.  
  218.         If Left(rtn, 6) = "Un Mil" Then
  219.  
  220.             rtn = Mid(rtn, 4)
  221.  
  222.         End If
  223.  
  224.         '//addAnd
  225.  
  226.         For i = 65 To 88
  227.  
  228.             If Not i = 77 Then
  229.  
  230.                 ReplaceAll(rtn, "a " + Chr(i), "* y " + Chr(i))
  231.  
  232.             End If
  233.  
  234.         Next
  235.  
  236.         ReplaceAll(rtn, "*", "a")
  237.  
  238.         IntNumToSpanish = rtn
  239.  
  240.     End Function
  241.  
  242.     Private Function EvalPart(ByVal x As Integer) As String
  243.  
  244.         Dim rtn As String
  245.  
  246.         Dim s As String
  247.  
  248.         Dim i As Integer
  249.  
  250.         Do
  251.  
  252.             Select Case x
  253.  
  254.                 Case 0 : s = "Cero"
  255.  
  256.                 Case 1 : s = "Un"
  257.  
  258.                 Case 2 : s = "Dos"
  259.  
  260.                 Case 3 : s = "Tres"
  261.  
  262.                 Case 4 : s = "Cuatro"
  263.  
  264.                 Case 5 : s = "Cinco"
  265.  
  266.                 Case 6 : s = "Seis"
  267.  
  268.                 Case 7 : s = "Siete"
  269.  
  270.                 Case 8 : s = "Ocho"
  271.  
  272.                 Case 9 : s = "Nueve"
  273.  
  274.                 Case 10 : s = "Diez"
  275.  
  276.                 Case 20 : s = "Veinte"
  277.  
  278.                 Case 30 : s = "Treinta"
  279.  
  280.                 Case 40 : s = "Cuarenta"
  281.  
  282.                 Case 50 : s = "Cincuenta"
  283.  
  284.                 Case 60 : s = "Sesenta"
  285.  
  286.                 Case 70 : s = "Setenta"
  287.  
  288.                 Case 80 : s = "Ochenta"
  289.  
  290.                 Case 90 : s = "Noventa"
  291.  
  292.                 Case 100 : s = "Cien"
  293.  
  294.                 Case 200 : s = "Doscientos"
  295.  
  296.                 Case 300 : s = "Trescientos"
  297.  
  298.                 Case 400 : s = "Cuatrocientos"
  299.  
  300.                 Case 500 : s = "Quinientos"
  301.  
  302.                 Case 600 : s = "Seiscientos"
  303.  
  304.                 Case 700 : s = "Setecientos"
  305.  
  306.                 Case 800 : s = "Ochocientos"
  307.  
  308.                 Case 900 : s = "Novecientos"
  309.  
  310.                 Case 1000 : s = "Mil"
  311.  
  312.                 Case 1000000 : s = "Millón"
  313.  
  314.             End Select
  315.  
  316.             If s = "" Then
  317.  
  318.                 i = i + 1
  319.  
  320.                 x = x / 1000
  321.  
  322.                 If x = 0 Then i = 0
  323.  
  324.             Else
  325.  
  326.                 Exit Do
  327.  
  328.             End If
  329.  
  330.         Loop Until i = 0
  331.  
  332.         rtn = s
  333.  
  334.         Select Case i
  335.  
  336.             Case 0 : s = ""
  337.  
  338.             Case 1 : s = " Mil"
  339.  
  340.             Case 2 : s = " Millones"
  341.  
  342.             Case 3 : s = " Billones"
  343.  
  344.         End Select
  345.  
  346.         EvalPart = rtn + s
  347.  
  348.         Exit Function
  349.  
  350.     End Function
  351.  
  352.     Private Sub ReplaceStringFrom( _
  353.         ByRef s As String, _
  354.         ByVal OldWrd As String, _
  355.         ByVal NewWrd As String, _
  356.         ByVal ptr As Integer)
  357.  
  358.         s = Left(s, ptr - 1) + NewWrd + Mid(s, Len(OldWrd) + ptr)
  359.  
  360.     End Sub
  361.  
  362.     Private Function Singular(ByVal s As String) As String
  363.  
  364.         If Len(s) >= 2 Then
  365.  
  366.             If Right(s, 1) = "s" Then
  367.  
  368.                 If Right(s, 2) = "es" Then
  369.  
  370.                     Singular = Left(s, Len(s) - 2)
  371.  
  372.                 Else
  373.  
  374.                     Singular = Left(s, Len(s) - 1)
  375.  
  376.                 End If
  377.  
  378.             Else
  379.  
  380.                 Singular = s
  381.  
  382.             End If
  383.  
  384.         End If
  385.  
  386.     End Function
  387.  
  388.     Private Function CloneChain(ByVal n As Integer, ByVal Chr As String)
  389.  
  390.         Dim i As Integer
  391.  
  392.         Dim CharClone As String
  393.  
  394.         Dim rtn As String
  395.  
  396.         If Len(Chr) Then
  397.  
  398.             CharClone = Mid(Chr, 1, 1)
  399.  
  400.             For i = 1 To n
  401.  
  402.                 rtn = rtn + CharClone
  403.  
  404.             Next
  405.  
  406.         End If
  407.  
  408.         Return rtn
  409.  
  410.     End Function
  411.  
  412.     Private Sub ReplaceAll( _
  413.         ByRef s As String, _
  414.         ByVal OldWrd As String, _
  415.         ByVal NewWrd As String)
  416.         Dim ptr As Integer
  417.  
  418.         Do
  419.  
  420.             ptr = InStr(s, OldWrd)
  421.  
  422.             If ptr Then
  423.  
  424.                 s = Left(s, ptr - 1) + NewWrd + Mid(s, Len(OldWrd) + ptr)
  425.  
  426.             End If
  427.  
  428.         Loop Until ptr = 0
  429.  
  430.     End Sub
  431.  
  432.  


Saludos  :comp:   :good: