[SOURCE] Función para pasar de Números a Letras

[ssccaann43]

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: (vb) [Seleccionar]

Function MontoEscrito(Monto As Currency) As String
 
Dim AMT As String
Dim n As String
Dim m As String
Dim k As String
Dim L As String
Dim Rtn_String As String * 120
 
n = "Un    Dos   Tres  CuatroCinco Seis  Siete Ocho  Nueve "
m = "Diez      Once      Doce      Trece     Catorce   Quince    Dieciseis DiecisieteDieciocho Diecinueve"
k = "Veinte   Treinta  Cuarenta CincuentaSesenta  Setenta  Ochenta  Noventa  "
L = "Cien         Doscientos   Trescientos  CuatrocientosQuinientos   Seiscientos  Setecientos  Ochocientos  Novecientos  "
 
If Monto = 0 Then
   MontoEscrito = ""
   Exit Function
End If
 
AMT = Format(Monto, "000000000.00")
Rtn_String = ""
 
If Mid(AMT, 1, 1) = 1 Then     ' 100 - 900 MILLONES
   Rtn_String = Trim(Mid(L, ((Mid(AMT, 1, 1) - 1) * 13) + 1, 13))
   If Trim(Mid(AMT, 1, 3)) > "100" Then
      Rtn_String = Trim(Rtn_String) & "to"
   End If
ElseIf Mid(AMT, 1, 1) > 1 Then
   Rtn_String = Trim(Mid(L, ((Mid(AMT, 1, 1) - 1) * 13) + 1, 13))
End If
 
If Mid(AMT, 2, 1) = 1 Then     ' 10 - 99 MILLONES
   Rtn_String = Trim(Rtn_String) & " " & Mid(m, (Mid(AMT, 3, 1) * 10) + 1, 10)
ElseIf Mid(AMT, 2, 1) > 1 Then
   Rtn_String = Trim(Rtn_String) & " " & Mid(k, ((Mid(AMT, 2, 1) - 2) * 9) + 1, 9)
   If Mid(AMT, 3, 1) > 0 Then
      Rtn_String = Trim(Rtn_String) & " y " & Mid(n, ((Mid(AMT, 3, 1) - 1) * 6) + 1, 6)
   End If
ElseIf Mid(AMT, 3, 1) > 0 Then  ' 1 - 9 MILLONES
   Rtn_String = Trim(Rtn_String) & " " & Mid(n, ((Mid(AMT, 3, 1) - 1) * 6) + 1, 6)
End If
 
If Trim(Rtn_String) <> "" Then
   If Mid(AMT, 1, 3) > 1 Then
      Rtn_String = Trim(Rtn_String) & " Millones "
   Else
      Rtn_String = Trim(Rtn_String) & " Millón "
   End If
End If
 
If Mid(AMT, 4, 1) = 1 Then    ' 100 - 900 MIL
   Rtn_String = Trim(Rtn_String) & " " & Trim(Mid(L, ((Mid(AMT, 4, 1) - 1) * 13) + 1, 13))
   If Mid(AMT, 4, 3) > "100" Then
      Rtn_String = Trim(Rtn_String) & "to"
   End If
ElseIf Mid(AMT, 4, 1) > 1 Then
   Rtn_String = Trim(Rtn_String) & " " & Mid(L, (((Mid(AMT, 4, 1) - 1) * 13) + 1), 13)
End If
 
If Mid(AMT, 5, 1) = 1 Then      ' 10 - 19 Miles
   Rtn_String = Trim(Rtn_String) & " " & Mid(m, (((Mid(AMT, 6, 1)) * 10) + 1), 10)
ElseIf Mid(AMT, 5, 1) > 1 Then  ' 20 - 99 Miles
   Rtn_String = Trim(Rtn_String) & " " & Mid(k, (((Mid(AMT, 5, 1) - 2) * 9) + 1), 9)
   If Mid(AMT, 6, 1) > 0 Then   ' 2? - 9? Miles
      Rtn_String = Trim(Rtn_String) & " y " & Mid(n, (((Mid(AMT, 6, 1) - 1) * 6) + 1), 6)
   End If
ElseIf Mid(AMT, 6, 1) > 0 Then   ' 1  - 9 Miles
   Rtn_String = Trim(Rtn_String) & " " & Mid(n, (((Mid(AMT, 6, 1) - 1) * 6) + 1), 6)
End If
 
If Mid(AMT, 1, 6) <> "000000" And Mid(AMT, 4, 3) <> "000" Then
   Rtn_String = Trim(Rtn_String) & " Mil "
End If
 
If Mid(AMT, 7, 1) = 1 Then
   Rtn_String = Trim(Rtn_String) & " " & Mid(L, (((Mid(AMT, 7, 1) - 1) * 13) + 1), 13)
   If Trim(Mid(AMT, 7, 3)) > "100" Then
      Rtn_String = Trim(Rtn_String) & "to"
   End If
ElseIf Mid(AMT, 7, 1) > 1 Then
   Rtn_String = Trim(Rtn_String) & " " & Mid(L, (((Mid(AMT, 7, 1) - 1) * 13) + 1), 13)
End If
 
If Mid(AMT, 8, 1) = 1 Then
   Rtn_String = Trim(Rtn_String) & " " & Mid(m, ((Mid(AMT, 9, 1) * 10) + 1), 10)
ElseIf Mid(AMT, 8, 1) > 1 Then
   Rtn_String = Trim(Rtn_String) & " " & Mid(k, (((Mid(AMT, 8, 1) - 2) * 9) + 1), 9)
   If Mid(AMT, 9, 1) > 0 Then
      Rtn_String = Trim(Rtn_String) & " y " & Mid(n, (((Mid(AMT, 9, 1) - 1) * 6) + 1), 6)
   End If
ElseIf Mid(AMT, 9, 1) > 0 Then
   Rtn_String = Trim(Rtn_String) & " " & Trim(Mid(n, (((Mid(AMT, 9, 1) - 1) * 6) + 1), 6))
   If Mid(AMT, 9, 1) = 1 Then
      Rtn_String = Trim(Rtn_String) & "o"
   End If
End If
 
If Trim(Rtn_String) <> "" Then
   Rtn_String = Trim(Rtn_String) & " con "
End If
 
Rtn_String = Trim(Rtn_String) & " " & Mid(AMT, 11, 2) & "/100"
 
 
MontoEscrito = Rtn_String
End Function

MOD...
Para usarlo pueden hacerlo así...
Ejemp...

Código: (vb) [Seleccionar]

Label1.Caption = MontoEscrito(TxtMonto.Text)


[omarinho23]

estupendo miguel grax justo lo necesitaba para las impresiones de facturas

estupendo aporte gracias!

[ssccaann43]

De nada, me alegra que te haya gustado...!

[erbuson]

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]

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...!

Por otro lado, creo sinceramente que puede mejorarse, no dudo de dicha posibilidad. Si crees que puedas mejorarlo, haslo. Aquí se aceptan mejoras...! 

[erbuson]

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]

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...!

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é.

[erbuson]

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]

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.

[ssccaann43]

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...!

Saludos a todos...

[cobein]

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]

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]

  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: (vb) [Seleccionar]

Option Explicit
Const glbSubS = "CENTAVO"
Const glbSubP = "CENTAVOS"
Const glbSubS2 = "cent�simo"
Const glbSubP2 = "cent�simos"
Function WordNum(ByVal Numero As String, Optional TipoCambioSingular As String, Optional TipoCambioPlural As String, Optional xInternal As Long) As String
         Dim sNum As String, vNum() As String, X As Long, Y As Long, Z As Long, sTmp As String
         Dim D1 As String, D2 As String, D3 As String, DFinal As String
         Dim tNum As String, B1 As Boolean, B2 As Boolean, B3 As Boolean
         Dim wNum() As String, Nombres() As String
         
         '**********************************************************************************************
         '* Esta funci�n convierte n�meros en palabras, sin importar el contexto donde se encuentren   *
         '* Es capaz de procesar n�meros de 123 d�gitos (Vigintillones) :-O                            *
         '* Solo se procesan 2 decimales si los hay                                                    *
         '**********************************************************************************************
         
         'Convierte el valor en un string
         sNum = Trim(Replace(CStr(Numero), ",", "."))
       
         'Procesa cada n�mero que exista en la variable por separado
         If xInternal = 0 Then
            'Separa los n�meros limpios de las palabras y los procesa por separado (no incluye n�meros con letras)
            wNum = Split(sNum, Space(1))
            For X = 0 To UBound(wNum)
                'Concatena los strings o n�meros seg�n corresponda
                If IsNumeric(wNum(X)) Then
                   'Separa los enteros de los decimales para procesarlos por separado
                   If InStr(1, wNum(X), ".", vbTextCompare) > 0 Then
                      'Proceso los enteros
                      D1 = left(wNum(X), InStrRev(wNum(X), ".", , vbTextCompare) - 1)
                      DFinal = DFinal & IIf(D1 < 0, "menos ", "") & WordNum(D1, TipoCambioSingular, TipoCambioPlural, 1)
                      'Proceso 2 decimales
                      D2 = Mid(Mid(wNum(X), InStrRev(wNum(X), ".", , vbTextCompare) + 1), 1, 2)
                      If Val(D2) > 0 Then
                         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)
                      End If
                   Else
                      DFinal = DFinal & IIf(wNum(X) < 0, "MENOS ", "") & WordNum(wNum(X), TipoCambioSingular, TipoCambioPlural, 1) & Space(1)
                   End If
                Else
                   DFinal = DFinal & wNum(X) & Space(1)
                End If
            Next
         Else
           
            'Elimina el signo
            If Not IsNumeric(left(sNum, 1)) Then
               sNum = Mid(sNum, 2)
            End If
         
            'Elimina cualquier formato posible (incluye valores cient�ficos)
            'sNum = Format(sNum, "0")
           
            If sNum = vbNullString Then sNum = "0"
           
            'Completa con ceros a la izquierda hasta obtener una longitud m�ltiplo de 3
            Do While Len(sNum) Mod 3 <> 0
               sNum = "0" & sNum
            Loop
         
            'Dimenciona un arreglo con espacio para cada una de las centenas
            ReDim vNum(Len(sNum) / 3 - 1)
           
            'Carga el arreglo con las centenas que corresponda
            For X = 0 To UBound(vNum, 1)
                vNum(X) = Mid(sNum, (X + 1) * 3 - 2, 3)
            Next
             
            'Si el arreglo contiene una sola centena, la convierte en palabras
            If UBound(vNum, 1) = 0 Then
                'Asigna los d�gitos de la centena y recuerda si son mayores que cero
                D3 = left(sNum, 1): B3 = Val(D3) > 0
                D2 = Mid(sNum, 2, 1): B2 = Val(D2) > 0
                D1 = Right(sNum, 1): B1 = Val(D1) > 0
               
                'Procesa las unidades
                Select Case D1
                       Case "1": DFinal = "UN"
                       Case "2": DFinal = "DOS"
                       Case "3": DFinal = "TRES"
                       Case "4": DFinal = "CUATRO"
                       Case "5": DFinal = "CINCO"
                       Case "6": DFinal = "SEIS"
                       Case "7": DFinal = "SIETE"
                       Case "8": DFinal = "OCHO"
                       Case "9": DFinal = "NUEVE"
                End Select
               
                'Procesa las decenas
                Select Case D2
                       Case "1"
                            'Maneja l�gica del retrasado mental que puso nombres il�gicos a algunos n�meros.
                            Select Case D1
                                   Case "0": DFinal = "DIEZ"
                                   Case "1": DFinal = "ONCE" 'dieciuno
                                   Case "2": DFinal = "DOCE" 'diecidos
                                   Case "3": DFinal = "TRECE" 'diecitres
                                   Case "4": DFinal = "CATORCE" 'diecicuatro
                                   Case "5": DFinal = "QUINCE" 'diecicinco
                                   Case "6": DFinal = "DIECISEIS" 'acento :(
                                   Case Else
                                        DFinal = "DIECI" & DFinal
                            End Select
                       Case "2"
                            If B1 Then
                               If D1 = "2" Then DFinal = "DOS"
                               If D1 = "3" Then DFinal = "TRES"
                               DFinal = "VEINTI" & DFinal
                            Else
                               DFinal = "VEINTE"
                            End If
                       Case "3": If B1 Then DFinal = "TREINTA Y " & DFinal Else DFinal = "TREINTA"
                       Case "4": If B1 Then DFinal = "CUARENTA Y " & DFinal Else DFinal = "CUARENTA"
                       Case "5": If B1 Then DFinal = "CINCUENTA Y " & DFinal Else DFinal = "CINCUENTA"
                       Case "6": If B1 Then DFinal = "SESENTA Y " & DFinal Else DFinal = "SESENTA"
                       Case "7": If B1 Then DFinal = "SETENTA Y " & DFinal Else DFinal = "SETENTA"
                       Case "8": If B1 Then DFinal = "OCHENTA Y " & DFinal Else DFinal = "OCHENTA"
                       Case "9": If B1 Then DFinal = "NOVENTA Y " & DFinal Else DFinal = "NOVENTA"
                End Select
               
                'Procesa las centenas
                Select Case D3
                       Case "1": If B1 Or B2 Then DFinal = "CIENTO " & DFinal Else DFinal = "CIEN"
                       Case "2": If B1 Or B2 Then DFinal = "DOSCIENTOS " & DFinal Else DFinal = "DOSCIENTOS"
                       Case "3": If B1 Or B2 Then DFinal = "TRESCIENTOS " & DFinal Else DFinal = "TRESCIENTOS"
                       Case "4": If B1 Or B2 Then DFinal = "CUATROCIENTOS " & DFinal Else DFinal = "CUATROCIENTOS"
                       Case "5": If B1 Or B2 Then DFinal = "QUINIENTOS " & DFinal Else DFinal = "QUINIENTOS"
                       Case "6": If B1 Or B2 Then DFinal = "SEISCIENTOS " & DFinal Else DFinal = "SEISCIENTOS"
                       Case "7": If B1 Or B2 Then DFinal = "SETECINETOS " & DFinal Else DFinal = "SETECIENTOS"
                       Case "8": If B1 Or B2 Then DFinal = "OCHOCIENTOS " & DFinal Else DFinal = "OCHOCIENTOS"
                       Case "9": If B1 Or B2 Then DFinal = "NOVECIENTOS " & DFinal Else DFinal = "NOVECIENTOS"
                End Select
               
                'Si es la ejecuci�n principal efectua algunos arreglines
                If xInternal = 1 Then
                   'Validaci�n del cero
                   If Trim(DFinal) = 0 Then DFinal = "CERO"
                   'Validaci�n de terminados en "un"
                   If Right(DFinal, 2) = "UN" And Len(TipoCambioSingular) = 0 Then DFinal = DFinal & "O"
                End If
               
            Else 'Si es m�s de una centena, las separa y procesa independientemente
                Y = -1
                Z = 1
                For X = UBound(vNum) To 0 Step -1
                    Y = Y + 1
                   
                    'Convierte la centena en palabras
                    tNum = WordNum(vNum(X), xInternal:=2)
                   
                    'Arregla la terminaci�n "uno" cuando corresponde
                    If Y = 0 And Right(tNum, 2) = "UN" And TipoCambioSingular & TipoCambioPlural = "" Then tNum = tNum + "O"
                   
                    'Genera un valor temporal para poder modificar
                    sTmp = tNum
                   
                    'Asigna los nombres gen�ricos principales
                    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 ", ",")
                   
                    'Controla que el �ndice de nombres no salga de los l�mites
                    If Y > UBound(Nombres) Then
                       WordNum = "?"
                       Exit Function
                    End If
                   
                    'Asigna los nombres correspondientes
                    If Y Mod 2 > 0 Then
                       D1 = Nombres(0)
                       D2 = Nombres(Y - 1)
                    ElseIf Y > 0 Then
                       D1 = Nombres(Y - 1)
                       D2 = Nombres(Y)
                    Else
                       D1 = "": D2 = ""
                    End If
                   
                    'Actualiza el nombre del n�mero
                    Select Case Y Mod 2
                           Case 0: If sTmp = "UN" Then sTmp = sTmp & D1 Else sTmp = sTmp & IIf(tNum = "", "", D2)
                           Case Else
                                If sTmp = "UN" Then sTmp = ""
                                sTmp = sTmp & IIf(tNum = "", "", D1)
                                If X = 0 And Y > 1 Then
                                   If InStr(1, DFinal, D2, vbTextCompare) = 0 Then sTmp = sTmp & Mid(D2, 2)
                                End If
                    End Select
                    DFinal = sTmp & DFinal
                Next
            End If
         End If
         
         'Aplica el tipo de moneda cuando corresponda
         If xInternal = 1 Then DFinal = DFinal & Space(1) & IIf(Format(sNum, "#0") = "1", TipoCambioSingular, TipoCambioPlural)
   
         'Asigna el n�mero en palabras
          WordNum = Trim(DFinal)
End Function

LA FORMA DE PODER UTILIZARLO ES LA SIGUIENTE

Código: (vb) [Seleccionar]

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

[ssccaann43]

Excelente Wolf, me gusta ese módulo...!

[erbuson]

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.