Autor Tema: [SOURCE] Función para pasar de Números a Letras  (Leído 4523 veces)

0 Usuarios y 1 Visitante están viendo este tema.

ssccaann43

  • Terabyte
  • *****
  • Mensajes: 923
  • Reputación: +93/-58
    • Ver Perfil
    • Sistemas Nuñez, Consultores y Soporte, C.A.
[SOURCE] Función para pasar de Números a Letras
« en: Febrero 17, 2010, 12:53:16 pm »
Bien esta funcion hace la conversión de Números a Letras. Espectacular para aquellos que imprimen cheques por ejemplo, o muestran reportes con montos y desean expresarlos en Letras.

Se agradecen los comentarios.

Saludos

Código: Visual Basic
  1. Function MontoEscrito(Monto As Currency) As String
  2.  
  3. Dim AMT As String
  4. Dim n As String
  5. Dim m As String
  6. Dim k As String
  7. Dim L As String
  8. Dim Rtn_String As String * 120
  9.  
  10. n = "Un    Dos   Tres  CuatroCinco Seis  Siete Ocho  Nueve "
  11. m = "Diez      Once      Doce      Trece     Catorce   Quince    Dieciseis DiecisieteDieciocho Diecinueve"
  12. k = "Veinte   Treinta  Cuarenta CincuentaSesenta  Setenta  Ochenta  Noventa  "
  13. L = "Cien         Doscientos   Trescientos  CuatrocientosQuinientos   Seiscientos  Setecientos  Ochocientos  Novecientos  "
  14.  
  15. If Monto = 0 Then
  16.    MontoEscrito = ""
  17.    Exit Function
  18. End If
  19.  
  20. AMT = Format(Monto, "000000000.00")
  21. Rtn_String = ""
  22.  
  23. If Mid(AMT, 1, 1) = 1 Then     ' 100 - 900 MILLONES
  24.   Rtn_String = Trim(Mid(L, ((Mid(AMT, 1, 1) - 1) * 13) + 1, 13))
  25.    If Trim(Mid(AMT, 1, 3)) > "100" Then
  26.       Rtn_String = Trim(Rtn_String) & "to"
  27.    End If
  28. ElseIf Mid(AMT, 1, 1) > 1 Then
  29.    Rtn_String = Trim(Mid(L, ((Mid(AMT, 1, 1) - 1) * 13) + 1, 13))
  30. End If
  31.  
  32. If Mid(AMT, 2, 1) = 1 Then     ' 10 - 99 MILLONES
  33.   Rtn_String = Trim(Rtn_String) & " " & Mid(m, (Mid(AMT, 3, 1) * 10) + 1, 10)
  34. ElseIf Mid(AMT, 2, 1) > 1 Then
  35.    Rtn_String = Trim(Rtn_String) & " " & Mid(k, ((Mid(AMT, 2, 1) - 2) * 9) + 1, 9)
  36.    If Mid(AMT, 3, 1) > 0 Then
  37.       Rtn_String = Trim(Rtn_String) & " y " & Mid(n, ((Mid(AMT, 3, 1) - 1) * 6) + 1, 6)
  38.    End If
  39. ElseIf Mid(AMT, 3, 1) > 0 Then  ' 1 - 9 MILLONES
  40.   Rtn_String = Trim(Rtn_String) & " " & Mid(n, ((Mid(AMT, 3, 1) - 1) * 6) + 1, 6)
  41. End If
  42.  
  43. If Trim(Rtn_String) <> "" Then
  44.    If Mid(AMT, 1, 3) > 1 Then
  45.       Rtn_String = Trim(Rtn_String) & " Millones "
  46.    Else
  47.       Rtn_String = Trim(Rtn_String) & " Millón "
  48.    End If
  49. End If
  50.  
  51. If Mid(AMT, 4, 1) = 1 Then    ' 100 - 900 MIL
  52.   Rtn_String = Trim(Rtn_String) & " " & Trim(Mid(L, ((Mid(AMT, 4, 1) - 1) * 13) + 1, 13))
  53.    If Mid(AMT, 4, 3) > "100" Then
  54.       Rtn_String = Trim(Rtn_String) & "to"
  55.    End If
  56. ElseIf Mid(AMT, 4, 1) > 1 Then
  57.    Rtn_String = Trim(Rtn_String) & " " & Mid(L, (((Mid(AMT, 4, 1) - 1) * 13) + 1), 13)
  58. End If
  59.  
  60. If Mid(AMT, 5, 1) = 1 Then      ' 10 - 19 Miles
  61.   Rtn_String = Trim(Rtn_String) & " " & Mid(m, (((Mid(AMT, 6, 1)) * 10) + 1), 10)
  62. ElseIf Mid(AMT, 5, 1) > 1 Then  ' 20 - 99 Miles
  63.   Rtn_String = Trim(Rtn_String) & " " & Mid(k, (((Mid(AMT, 5, 1) - 2) * 9) + 1), 9)
  64.    If Mid(AMT, 6, 1) > 0 Then   ' 2? - 9? Miles
  65.      Rtn_String = Trim(Rtn_String) & " y " & Mid(n, (((Mid(AMT, 6, 1) - 1) * 6) + 1), 6)
  66.    End If
  67. ElseIf Mid(AMT, 6, 1) > 0 Then   ' 1  - 9 Miles
  68.   Rtn_String = Trim(Rtn_String) & " " & Mid(n, (((Mid(AMT, 6, 1) - 1) * 6) + 1), 6)
  69. End If
  70.  
  71. If Mid(AMT, 1, 6) <> "000000" And Mid(AMT, 4, 3) <> "000" Then
  72.    Rtn_String = Trim(Rtn_String) & " Mil "
  73. End If
  74.  
  75. If Mid(AMT, 7, 1) = 1 Then
  76.    Rtn_String = Trim(Rtn_String) & " " & Mid(L, (((Mid(AMT, 7, 1) - 1) * 13) + 1), 13)
  77.    If Trim(Mid(AMT, 7, 3)) > "100" Then
  78.       Rtn_String = Trim(Rtn_String) & "to"
  79.    End If
  80. ElseIf Mid(AMT, 7, 1) > 1 Then
  81.    Rtn_String = Trim(Rtn_String) & " " & Mid(L, (((Mid(AMT, 7, 1) - 1) * 13) + 1), 13)
  82. End If
  83.  
  84. If Mid(AMT, 8, 1) = 1 Then
  85.    Rtn_String = Trim(Rtn_String) & " " & Mid(m, ((Mid(AMT, 9, 1) * 10) + 1), 10)
  86. ElseIf Mid(AMT, 8, 1) > 1 Then
  87.    Rtn_String = Trim(Rtn_String) & " " & Mid(k, (((Mid(AMT, 8, 1) - 2) * 9) + 1), 9)
  88.    If Mid(AMT, 9, 1) > 0 Then
  89.       Rtn_String = Trim(Rtn_String) & " y " & Mid(n, (((Mid(AMT, 9, 1) - 1) * 6) + 1), 6)
  90.    End If
  91. ElseIf Mid(AMT, 9, 1) > 0 Then
  92.    Rtn_String = Trim(Rtn_String) & " " & Trim(Mid(n, (((Mid(AMT, 9, 1) - 1) * 6) + 1), 6))
  93.    If Mid(AMT, 9, 1) = 1 Then
  94.       Rtn_String = Trim(Rtn_String) & "o"
  95.    End If
  96. End If
  97.  
  98. If Trim(Rtn_String) <> "" Then
  99.    Rtn_String = Trim(Rtn_String) & " con "
  100. End If
  101.  
  102. Rtn_String = Trim(Rtn_String) & " " & Mid(AMT, 11, 2) & "/100"
  103.  
  104.  
  105. MontoEscrito = Rtn_String
  106. End Function
  107.  

MOD...
Para usarlo pueden hacerlo así...
Ejemp...
Código: Visual Basic
  1. Label1.Caption = MontoEscrito(TxtMonto.Text)
  2.  
« última modificación: Febrero 22, 2010, 12:57:48 pm por ssccaann43 »
Miguel Núñez.

omarinho23

  • Megabyte
  • ***
  • Mensajes: 105
  • Reputación: +0/-1
    • Ver Perfil
Re:[SOURCE] Función para pasar de Números a Letras
« Respuesta #1 en: Febrero 17, 2010, 01:08:47 pm »
estupendo miguel grax justo lo necesitaba para las impresiones de facturas

estupendo aporte gracias!

ssccaann43

  • Terabyte
  • *****
  • Mensajes: 923
  • Reputación: +93/-58
    • Ver Perfil
    • Sistemas Nuñez, Consultores y Soporte, C.A.
Re:[SOURCE] Función para pasar de Números a Letras
« Respuesta #2 en: Febrero 17, 2010, 01:24:38 pm »
De nada, me alegra que te haya gustado...!
Miguel Núñez.

erbuson

  • Kilobyte
  • **
  • Mensajes: 75
  • Reputación: +11/-1
    • Ver Perfil
Re:[SOURCE] Función para pasar de Números a Letras
« Respuesta #3 en: Febrero 19, 2010, 01:02:35 pm »
Hola, creo que tiene un pequeño "error" cuando se trata de una cantidad de mil ya que por ejemplo indica:

1254 = un mil doscientos cincuenta y cuatro

Por otra parte es realmente simple, había visto rutinas similares pero el código es mas largo.

Saludos


ssccaann43

  • Terabyte
  • *****
  • Mensajes: 923
  • Reputación: +93/-58
    • Ver Perfil
    • Sistemas Nuñez, Consultores y Soporte, C.A.
Re:[SOURCE] Función para pasar de Números a Letras
« Respuesta #4 en: Febrero 19, 2010, 01:08:16 pm »
Hola, creo que tiene un pequeño "error" cuando se trata de una cantidad de mil ya que por ejemplo indica:

1254 = un mil doscientos cincuenta y cuatro

Por otra parte es realmente simple, había visto rutinas similares pero el código es mas largo.

Saludos



Pues, quizás lo ves como error... Pero está bien...! Es realmente asi..

1455 = un mil cuatrocientos cincuenta y cinco...

Hasta ahora los cheques impresos por mi software que usan el módulo pues todos han sido procesados sin problemas...! :D

Por otro lado, creo sinceramente que puede mejorarse, no dudo de dicha posibilidad. Si crees que puedas mejorarlo, haslo. Aquí se aceptan mejoras...!  ;D
Miguel Núñez.

erbuson

  • Kilobyte
  • **
  • Mensajes: 75
  • Reputación: +11/-1
    • Ver Perfil
Re:[SOURCE] Función para pasar de Números a Letras
« Respuesta #5 en: Febrero 19, 2010, 07:21:09 pm »
Hola:
Lamento que lo tomes como una crítica pero en España donde vivo, no decimos un mil quinientos cuatro sino que decimos mil quinientos cuatro, por otra parte entiendo que los cheques se den por buenos ya que se entiende perfectamente lo que quiere decir.

Disculpa si en algo te ofendí.

ssccaann43

  • Terabyte
  • *****
  • Mensajes: 923
  • Reputación: +93/-58
    • Ver Perfil
    • Sistemas Nuñez, Consultores y Soporte, C.A.
Re:[SOURCE] Función para pasar de Números a Letras
« Respuesta #6 en: Febrero 19, 2010, 07:26:28 pm »
Amigo, bienvenido al foro. No me ofendí. Y comprendo que donde vivas no lo expresen de esa manera. Acá tampoco decimos Un mil quinientos, pero al momento de escribirlo en un cheque, o voucher, no hay problema...! ;D

Saludos, y espero continues visitando al foro. La idea es aportar ideas, mejorar codigos y ayudar a los demas. Creeme que tú critica fue constructiva. Lo sé.
Miguel Núñez.

erbuson

  • Kilobyte
  • **
  • Mensajes: 75
  • Reputación: +11/-1
    • Ver Perfil
Re:[SOURCE] Función para pasar de Números a Letras
« Respuesta #7 en: Febrero 19, 2010, 08:18:22 pm »
Hola, llevo ya algún tiempo, fíjate que todavía existían las pesetas, utilizando esta hecha por mi que aunque probablemente es un poco mas compleja en el montaje de la misma, ya no me acuerdo muy bien de como me compliqué, tiene algunas opciones más y es simple añadirle otras:

Por otra parte sólo indica decimales si los hay y no en el formato 20/100 sino 'con veinte céntimos' y el grupo del 20 no indica veinte y .... que evidentemente es correcto sino veinti.... tal vez soy demasiado remirado cuidando estos pequeños detalles, pero inicialmente la utilicé no para rellenar cheques sino para convertir importes en documentos legales como escrituras y no está muy bien visto por los notarios españoles que son muy exigentes en este aspecto estas llamemosles faltas ortográficas.

Código: [Seleccionar]
'-- Devuelve un importe en letras
'   Moneda = euro, peseta, dolar, libra
'
Public Function EnLetras(Importe As Currency, Optional Moneda As String = "euro") As String
Dim Salida As String, De As String, Con As String
Dim Modo_a As String, Son_1 As String
Dim Modo_o As String, Son_n As String
Dim Cantidad As Currency
Dim Parte As Single, Centimos As Single, Decima As String
Dim Auxiliar As Currency

Select Case Moneda
  Case "euro"
    Modo_o = "o"
    Modo_a = "o"
    Son_1 = " euro"
    Son_n = " euros"
    Decima = " céntimo"
  Case "peseta"
    Modo_o = "o"
    Modo_a = "a"
    Son_1 = " peseta"
    Son_n = " pesetas"
    Decima = ""
  Case "libra"
    Modo_o = "o"
    Modo_a = "a"
    Son_1 = " libra"
    Son_n = " libras"
    Decima = " penique"
  Case "dolar"
    Modo_o = "o"
    Modo_a = "o"
    Son_1 = " dólar"
    Son_n = " dólares"
    Decima = " centavo"
   
End Select

'-- Valor Inicial y comprobación de cero
If Importe < 0 Then Auxiliar = Importe * -1 Else Auxiliar = Importe
Cantidad = Int(Auxiliar)
Centimos = (Auxiliar - Cantidad) * 100
If Auxiliar = 0 Then GoTo ByeLetras

' Centimos
If Centimos > 0 Then
  Con = De0a999(Centimos, Modo_o)
  If Cantidad <> 0 Then Con = " con " & Con & Decima
  If Centimos > 1 Then Con = Con & "s"
End If

' Millones
Parte = Cantidad \ 1000000
If Cantidad Mod 1000000 = 0 Then De = " de"
If Parte > 0 Then
  If Parte > 1 Then
    Salida = De0a999(Parte, Modo_o) & " millones"
  Else
    Salida = "un millón"
  End If
  Cantidad = Cantidad - (Parte * 1000000)
  If Cantidad = 0 Then GoTo ByeLetras
End If

' Miles
Parte = Cantidad \ 1000
If Parte > 0 Then
  If Parte > 1 Then Salida = Salida & " " & De0a999(Parte, Modo_a)
  Salida = Salida & " mil"
  Cantidad = Cantidad - (Parte * 1000)
  If Cantidad = 0 Then GoTo ByeLetras
End If

' Unidades
Parte = Cantidad
If Parte > 0 Then
  Salida = Salida & " " & De0a999(Parte, Modo_a)
  Cantidad = Cantidad - Parte
  If Cantidad = 0 Then GoTo ByeLetras
End If

ByeLetras:
If Salida <> "" Then
  If Int(Auxiliar) = 1 Then
    EnLetras = LTrim$(RTrim$(Salida)) & Son_1 & Con
  Else
    EnLetras = LTrim$(RTrim$(Salida)) & De & Son_n & Con
  End If
End If

End Function

'
'-- Devuelve el valor en letras de 0 a 999 (Auxiliar de EnLetras)
'   Modo = o Masculino / a Femenino
'
Private Function De0a999(Digito As Single, Modo As String) As String

  Dim Dato As String, Arroba As Integer
  Select Case Digito
    Case 0: Dato = "cero"
    Case 1: Dato = "un": If Modo = "a" Then Dato = "una"
    Case 2: Dato = "dos"
    Case 3: Dato = "tres"
    Case 4: Dato = "cuatro"
    Case 5: Dato = "cinco"
    Case 6: Dato = "seis"
    Case 7: Dato = "siete"
    Case 8: Dato = "ocho"
    Case 9: Dato = "nueve"
    Case 10: Dato = "diez"
    Case 11: Dato = "once"
    Case 12: Dato = "doce"
    Case 13: Dato = "trece"
    Case 14: Dato = "catorce"
    Case 15: Dato = "quince"
    Case 16 To 19: Dato = "dieci" & De0a999(Digito - 10, Modo)
    Case 20: Dato = "veinte"
    Case 21 To 29: Dato = "veinti" & De0a999(Digito - 20, Modo)
    Case 30: Dato = "treinta"
    Case 31 To 39: Dato = "treinta y " & De0a999(Digito - 30, Modo)
    Case 40: Dato = "cuarenta"
    Case 41 To 49: Dato = "cuarenta y " & De0a999(Digito - 40, Modo)
    Case 50: Dato = "cincuenta"
    Case 51 To 59: Dato = "cincuenta y " & De0a999(Digito - 50, Modo)
    Case 60: Dato = "sesenta"
    Case 61 To 69: Dato = "sesenta y " & De0a999(Digito - 60, Modo)
    Case 70: Dato = "setenta"
    Case 71 To 79: Dato = "setenta y " & De0a999(Digito - 70, Modo)
    Case 80: Dato = "ochenta"
    Case 81 To 89: Dato = "ochenta y " & De0a999(Digito - 80, Modo)
    Case 90: Dato = "noventa"
    Case 91 To 99: Dato = "noventa y " & De0a999(Digito - 90, Modo)
    Case 100: Dato = "cien"
    Case 101 To 199: Dato = "ciento " & De0a999(Digito - 100, Modo)
    Case 200: Dato = "doscient@s"
    Case 201 To 299: Dato = "doscient@s " & De0a999(Digito - 200, Modo)
    Case 300: Dato = "trescient@s"
    Case 301 To 399: Dato = "trescient@s " & De0a999(Digito - 300, Modo)
    Case 400: Dato = "cuatrocient@s"
    Case 401 To 499: Dato = "cuatrocient@s " & De0a999(Digito - 400, Modo)
    Case 500: Dato = "quinient@s"
    Case 501 To 599: Dato = "quinient@s " & De0a999(Digito - 500, Modo)
    Case 600: Dato = "seiscient@s"
    Case 601 To 699: Dato = "seiscient@s " & De0a999(Digito - 600, Modo)
    Case 700: Dato = "setecient@s"
    Case 701 To 799: Dato = "setecient@s " & De0a999(Digito - 700, Modo)
    Case 800: Dato = "ochocient@s"
    Case 801 To 899: Dato = "ochocient@s " & De0a999(Digito - 800, Modo)
    Case 900: Dato = "novecient@s"
    Case 901 To 999: Dato = "novecient@s " & De0a999(Digito - 900, Modo)
    Case Else: Dato = ""
  End Select
 
  Arroba = InStr(Dato, "@")
  If Arroba > 0 Then Mid$(Dato, Arroba, 1) = Modo
   
  De0a999 = Dato
   
  End Function

Con un simple Text1 y un Label bastante largo se puede probar con este código

Private Sub Text1_Change()
  If Text1 <> "" Then Label1.Caption = EnLetras(CCur(Text1), "dolar")
End Sub

Saludos


seba123neo

  • Terabyte
  • *****
  • Mensajes: 744
  • Reputación: +83/-5
    • Ver Perfil
Re:[SOURCE] Función para pasar de Números a Letras
« Respuesta #8 en: Febrero 19, 2010, 09:34:44 pm »
pero hombre no es que este mal o tenga un error, es obvio el codigo de ssccaann43 no es para que se adapte a todos los paises del mundo y las formas de mostrar el importe en el cheque...simplemente mostro la idea y despues cada uno a la suya, algunos dicen de tal forma y otros de otra...lo unico que hay que hacer es cambiarle 2 palabras y listo...adaptarlo a la necesidad de uno.

por cierto aca en argentina los importes de mas de mil empiezan tambein con "un mil" aunque esta mal deberia decir "mil" y los centavos se ponen asi 50/100 eso serian 50 centavos, pero creo que varia segun el banco no estoy seguro...

saludos.
Quien nunca ha cometido un error nunca ha probado algo nuevo - Albert Einstein

ssccaann43

  • Terabyte
  • *****
  • Mensajes: 923
  • Reputación: +93/-58
    • Ver Perfil
    • Sistemas Nuñez, Consultores y Soporte, C.A.
Re:[SOURCE] Función para pasar de Números a Letras
« Respuesta #9 en: Febrero 20, 2010, 02:27:00 am »
Es correcto lo que dices seba... Se expresa al final 00/100...! Con ello indico que no hay centimos... En caso de existir 50, sería: 50/100...! ;D

Saludos a todos...
« última modificación: Febrero 20, 2010, 02:33:10 am por ssccaann43 »
Miguel Núñez.

cobein

  • Moderador Global
  • Gigabyte
  • *****
  • Mensajes: 344
  • Reputación: +63/-0
  • Más Argentino que el morcipan
    • Ver Perfil
Re:[SOURCE] Función para pasar de Números a Letras
« Respuesta #10 en: Febrero 20, 2010, 06:52:06 am »
Me quede envenenado con el "un mil" y despues de buscar un poco... esta bien, no es la manera que se acostumbra a usar en argentina por lo menos pero es un decimo de mil porciento correcto.

erbuson

  • Kilobyte
  • **
  • Mensajes: 75
  • Reputación: +11/-1
    • Ver Perfil
Re:[SOURCE] Función para pasar de Números a Letras
« Respuesta #11 en: Febrero 20, 2010, 12:03:50 pm »
No se trata desde luego de abrir un debate sobre si es o no es correcto, buscando en internet aparecen los que dicen que esta bien y los que dicen que no esta mal, aunque si he encontrado esto que indica para la comunidad del Euro como deben escribirse aqui os dejo el enlace (es un DOC de Word) mientras exista que da unas normas a seguir, comprobado que AHORA funciona respetando aquellas normas.

El Euro y su escritura en letra http://dayvox.net/iesvb/iesvb/apuntes/doc/159doc.doc

Mi código aquí, en este foro, tiene un error que no indica valor si sólo se le mandan céntimos. En este enlace el mismo está corregido.

Convertir importes de números a letras http://www.foro.vb-mundo.com/f24/convertir-importes-de-numeros-a-letras-17108/

Saludos a todos y perdón por mi insistencia pero es que soy muy tozudo y no me rindo facilmente, ya lo dijo no se quién la perseverancia y la insistencia son las madres de la ciencia.







wolf_kof

  • Visitante
Re:[SOURCE] Funci�n para pasar de N�meros a Letras
« Respuesta #12 en: Febrero 22, 2010, 02:14:59 am »
 :o Bueno creo que si nos vamos a poner a discutir por como convertir numeros a lestras deberian de tomas en cuenta que:

1. Numeros a letras es lo siguiente:
                        1 = uno
                        2 = dos
                   1000 = mil

2. Monedas a Letras es muy aparte por que tienen que llevar el sinbolo de la moneda y los decimales expresados como centavos o centesimas.

yo por mi parte desde hace algun tiempo tube este problema y me baje un modulo muy bueno pero tuve que hacerle algunas modificaciones (Saben que no me gusta mucho el codigo) jejejeje  ::)

aqui esta si a alguien le sirve

Código: Visual Basic
  1. Option Explicit
  2. Const glbSubS = "CENTAVO"
  3. Const glbSubP = "CENTAVOS"
  4. Const glbSubS2 = "cent�simo"
  5. Const glbSubP2 = "cent�simos"
  6. Function WordNum(ByVal Numero As String, Optional TipoCambioSingular As String, Optional TipoCambioPlural As String, Optional xInternal As Long) As String
  7.          Dim sNum As String, vNum() As String, X As Long, Y As Long, Z As Long, sTmp As String
  8.          Dim D1 As String, D2 As String, D3 As String, DFinal As String
  9.          Dim tNum As String, B1 As Boolean, B2 As Boolean, B3 As Boolean
  10.          Dim wNum() As String, Nombres() As String
  11.          
  12.          '**********************************************************************************************
  13.         '* Esta funci�n convierte n�meros en palabras, sin importar el contexto donde se encuentren   *
  14.         '* Es capaz de procesar n�meros de 123 d�gitos (Vigintillones) :-O                            *
  15.         '* Solo se procesan 2 decimales si los hay                                                    *
  16.         '**********************************************************************************************
  17.        
  18.          'Convierte el valor en un string
  19.         sNum = Trim(Replace(CStr(Numero), ",", "."))
  20.        
  21.          'Procesa cada n�mero que exista en la variable por separado
  22.         If xInternal = 0 Then
  23.             'Separa los n�meros limpios de las palabras y los procesa por separado (no incluye n�meros con letras)
  24.            wNum = Split(sNum, Space(1))
  25.             For X = 0 To UBound(wNum)
  26.                 'Concatena los strings o n�meros seg�n corresponda
  27.                If IsNumeric(wNum(X)) Then
  28.                    'Separa los enteros de los decimales para procesarlos por separado
  29.                   If InStr(1, wNum(X), ".", vbTextCompare) > 0 Then
  30.                       'Proceso los enteros
  31.                      D1 = left(wNum(X), InStrRev(wNum(X), ".", , vbTextCompare) - 1)
  32.                       DFinal = DFinal & IIf(D1 < 0, "menos ", "") & WordNum(D1, TipoCambioSingular, TipoCambioPlural, 1)
  33.                       'Proceso 2 decimales
  34.                      D2 = Mid(Mid(wNum(X), InStrRev(wNum(X), ".", , vbTextCompare) + 1), 1, 2)
  35.                       If Val(D2) > 0 Then
  36.                          If left(D2, 1) = "0" Then DFinal = DFinal & " CON " & WordNum(D2, glbSubS2, glbSubP2, 1) & Space(1) Else DFinal = DFinal & " CON " & WordNum(D2, glbSubS, glbSubP, 1) & Space(1)
  37.                       End If
  38.                    Else
  39.                       DFinal = DFinal & IIf(wNum(X) < 0, "MENOS ", "") & WordNum(wNum(X), TipoCambioSingular, TipoCambioPlural, 1) & Space(1)
  40.                    End If
  41.                 Else
  42.                    DFinal = DFinal & wNum(X) & Space(1)
  43.                 End If
  44.             Next
  45.          Else
  46.            
  47.             'Elimina el signo
  48.            If Not IsNumeric(left(sNum, 1)) Then
  49.                sNum = Mid(sNum, 2)
  50.             End If
  51.          
  52.             'Elimina cualquier formato posible (incluye valores cient�ficos)
  53.            'sNum = Format(sNum, "0")
  54.            
  55.             If sNum = vbNullString Then sNum = "0"
  56.            
  57.             'Completa con ceros a la izquierda hasta obtener una longitud m�ltiplo de 3
  58.            Do While Len(sNum) Mod 3 <> 0
  59.                sNum = "0" & sNum
  60.             Loop
  61.          
  62.             'Dimenciona un arreglo con espacio para cada una de las centenas
  63.            ReDim vNum(Len(sNum) / 3 - 1)
  64.            
  65.             'Carga el arreglo con las centenas que corresponda
  66.            For X = 0 To UBound(vNum, 1)
  67.                 vNum(X) = Mid(sNum, (X + 1) * 3 - 2, 3)
  68.             Next
  69.              
  70.             'Si el arreglo contiene una sola centena, la convierte en palabras
  71.            If UBound(vNum, 1) = 0 Then
  72.                 'Asigna los d�gitos de la centena y recuerda si son mayores que cero
  73.                D3 = left(sNum, 1): B3 = Val(D3) > 0
  74.                 D2 = Mid(sNum, 2, 1): B2 = Val(D2) > 0
  75.                 D1 = Right(sNum, 1): B1 = Val(D1) > 0
  76.                
  77.                 'Procesa las unidades
  78.                Select Case D1
  79.                        Case "1": DFinal = "UN"
  80.                        Case "2": DFinal = "DOS"
  81.                        Case "3": DFinal = "TRES"
  82.                        Case "4": DFinal = "CUATRO"
  83.                        Case "5": DFinal = "CINCO"
  84.                        Case "6": DFinal = "SEIS"
  85.                        Case "7": DFinal = "SIETE"
  86.                        Case "8": DFinal = "OCHO"
  87.                        Case "9": DFinal = "NUEVE"
  88.                 End Select
  89.                
  90.                 'Procesa las decenas
  91.                Select Case D2
  92.                        Case "1"
  93.                             'Maneja l�gica del retrasado mental que puso nombres il�gicos a algunos n�meros.
  94.                            Select Case D1
  95.                                    Case "0": DFinal = "DIEZ"
  96.                                    Case "1": DFinal = "ONCE" 'dieciuno
  97.                                   Case "2": DFinal = "DOCE" 'diecidos
  98.                                   Case "3": DFinal = "TRECE" 'diecitres
  99.                                   Case "4": DFinal = "CATORCE" 'diecicuatro
  100.                                   Case "5": DFinal = "QUINCE" 'diecicinco
  101.                                   Case "6": DFinal = "DIECISEIS" 'acento :(
  102.                                   Case Else
  103.                                         DFinal = "DIECI" & DFinal
  104.                             End Select
  105.                        Case "2"
  106.                             If B1 Then
  107.                                If D1 = "2" Then DFinal = "DOS"
  108.                                If D1 = "3" Then DFinal = "TRES"
  109.                                DFinal = "VEINTI" & DFinal
  110.                             Else
  111.                                DFinal = "VEINTE"
  112.                             End If
  113.                        Case "3": If B1 Then DFinal = "TREINTA Y " & DFinal Else DFinal = "TREINTA"
  114.                        Case "4": If B1 Then DFinal = "CUARENTA Y " & DFinal Else DFinal = "CUARENTA"
  115.                        Case "5": If B1 Then DFinal = "CINCUENTA Y " & DFinal Else DFinal = "CINCUENTA"
  116.                        Case "6": If B1 Then DFinal = "SESENTA Y " & DFinal Else DFinal = "SESENTA"
  117.                        Case "7": If B1 Then DFinal = "SETENTA Y " & DFinal Else DFinal = "SETENTA"
  118.                        Case "8": If B1 Then DFinal = "OCHENTA Y " & DFinal Else DFinal = "OCHENTA"
  119.                        Case "9": If B1 Then DFinal = "NOVENTA Y " & DFinal Else DFinal = "NOVENTA"
  120.                 End Select
  121.                
  122.                 'Procesa las centenas
  123.                Select Case D3
  124.                        Case "1": If B1 Or B2 Then DFinal = "CIENTO " & DFinal Else DFinal = "CIEN"
  125.                        Case "2": If B1 Or B2 Then DFinal = "DOSCIENTOS " & DFinal Else DFinal = "DOSCIENTOS"
  126.                        Case "3": If B1 Or B2 Then DFinal = "TRESCIENTOS " & DFinal Else DFinal = "TRESCIENTOS"
  127.                        Case "4": If B1 Or B2 Then DFinal = "CUATROCIENTOS " & DFinal Else DFinal = "CUATROCIENTOS"
  128.                        Case "5": If B1 Or B2 Then DFinal = "QUINIENTOS " & DFinal Else DFinal = "QUINIENTOS"
  129.                        Case "6": If B1 Or B2 Then DFinal = "SEISCIENTOS " & DFinal Else DFinal = "SEISCIENTOS"
  130.                        Case "7": If B1 Or B2 Then DFinal = "SETECINETOS " & DFinal Else DFinal = "SETECIENTOS"
  131.                        Case "8": If B1 Or B2 Then DFinal = "OCHOCIENTOS " & DFinal Else DFinal = "OCHOCIENTOS"
  132.                        Case "9": If B1 Or B2 Then DFinal = "NOVECIENTOS " & DFinal Else DFinal = "NOVECIENTOS"
  133.                 End Select
  134.                
  135.                 'Si es la ejecuci�n principal efectua algunos arreglines
  136.                If xInternal = 1 Then
  137.                    'Validaci�n del cero
  138.                   If Trim(DFinal) = 0 Then DFinal = "CERO"
  139.                    'Validaci�n de terminados en "un"
  140.                   If Right(DFinal, 2) = "UN" And Len(TipoCambioSingular) = 0 Then DFinal = DFinal & "O"
  141.                 End If
  142.                
  143.             Else 'Si es m�s de una centena, las separa y procesa independientemente
  144.                Y = -1
  145.                 Z = 1
  146.                 For X = UBound(vNum) To 0 Step -1
  147.                     Y = Y + 1
  148.                    
  149.                     'Convierte la centena en palabras
  150.                    tNum = WordNum(vNum(X), xInternal:=2)
  151.                    
  152.                     'Arregla la terminaci�n "uno" cuando corresponde
  153.                    If Y = 0 And Right(tNum, 2) = "UN" And TipoCambioSingular & TipoCambioPlural = "" Then tNum = tNum + "O"
  154.                    
  155.                     'Genera un valor temporal para poder modificar
  156.                    sTmp = tNum
  157.                    
  158.                     'Asigna los nombres gen�ricos principales
  159.                    Nombres = Split(" MIL , MILL�N , MILLONES , Bill�n , Billones , Trill�n , Trillones , Cuatrill�n , cuatrillones , quintill�n , quintillones , sextill�n , sextillones , septill�n , septillones , octill�n , octillones , nonill�n , nonillones , decill�n , decillones , undecill�n , undecillones , duodecill�n , duodecillones , tredecill�n , tredecillones , cuatordecill�n , cuatordecillones , quindecill�n , quindecillones , sexdecill�n , sexdecillones , septendecill�n , septendecillones , octodecill�n , octodecillones , novendecill�n , novendecillones , vigintill�n , vigintillones ", ",")
  160.                    
  161.                     'Controla que el �ndice de nombres no salga de los l�mites
  162.                    If Y > UBound(Nombres) Then
  163.                        WordNum = "?"
  164.                        Exit Function
  165.                     End If
  166.                    
  167.                     'Asigna los nombres correspondientes
  168.                    If Y Mod 2 > 0 Then
  169.                        D1 = Nombres(0)
  170.                        D2 = Nombres(Y - 1)
  171.                     ElseIf Y > 0 Then
  172.                        D1 = Nombres(Y - 1)
  173.                        D2 = Nombres(Y)
  174.                     Else
  175.                        D1 = "": D2 = ""
  176.                     End If
  177.                    
  178.                     'Actualiza el nombre del n�mero
  179.                    Select Case Y Mod 2
  180.                            Case 0: If sTmp = "UN" Then sTmp = sTmp & D1 Else sTmp = sTmp & IIf(tNum = "", "", D2)
  181.                            Case Else
  182.                                 If sTmp = "UN" Then sTmp = ""
  183.                                 sTmp = sTmp & IIf(tNum = "", "", D1)
  184.                                 If X = 0 And Y > 1 Then
  185.                                    If InStr(1, DFinal, D2, vbTextCompare) = 0 Then sTmp = sTmp & Mid(D2, 2)
  186.                                 End If
  187.                     End Select
  188.                     DFinal = sTmp & DFinal
  189.                 Next
  190.             End If
  191.          End If
  192.          
  193.          'Aplica el tipo de moneda cuando corresponda
  194.         If xInternal = 1 Then DFinal = DFinal & Space(1) & IIf(Format(sNum, "#0") = "1", TipoCambioSingular, TipoCambioPlural)
  195.    
  196.          'Asigna el n�mero en palabras
  197.          WordNum = Trim(DFinal)
  198. End Function


LA FORMA DE PODER UTILIZARLO ES LA SIGUIENTE

Código: Visual Basic
  1. Text19.Text = WordNum(Text11.Text, "QUETZAL", "QUETZALES")

al entrar al modulo lo podemos modificar con lo de centavos o decimales jejeje espero que les sirva es otra opci�n como la de ssccaann

YA ESTA MODIFICADO LO DE VEINTE PERDON PARA LOS QUE LO NOTARON JEJEJEJE YA PUEDEN CAMBIAR EL CODIGO
« última modificación: Febrero 23, 2010, 02:48:22 am por wolf_kof »

ssccaann43

  • Terabyte
  • *****
  • Mensajes: 923
  • Reputación: +93/-58
    • Ver Perfil
    • Sistemas Nuñez, Consultores y Soporte, C.A.
Re:[SOURCE] Función para pasar de Números a Letras
« Respuesta #13 en: Febrero 22, 2010, 12:43:59 pm »
Excelente Wolf, me gusta ese módulo...!
Miguel Núñez.

erbuson

  • Kilobyte
  • **
  • Mensajes: 75
  • Reputación: +11/-1
    • Ver Perfil
Re:[SOURCE] Funci�n para pasar de N�meros a Letras
« Respuesta #14 en: Febrero 22, 2010, 01:15:50 pm »
Hola:

El código es casi perfecto, y lo de casi lo digo porque por desgracia perfecto lo que se dice perfecto no hay nada.
Tiene el mismo problema de los decimales que tenía antes el mio, lo comento por si deseas cambiarlo ya que como todos sabemos es prácticamente imposible que probemos todas las posibilidades.

Cuando indicas sólo decimales, no funciona correctamente  o yo no he sabido hacerlo funcionar.
De otro lado tiene el "veinte" que siempre sale en minúsculas

Saludos y enhorabuena.