Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: ssccaann43 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
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...
Label1.Caption = MontoEscrito(TxtMonto.Text)
-
estupendo miguel grax justo lo necesitaba para las impresiones de facturas
estupendo aporte gracias!
-
De nada, me alegra que te haya gustado...!
-
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
-
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
-
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í.
-
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é.
-
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.
'-- 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
-
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.
-
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...
-
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.
-
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.
-
: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
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
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
-
Excelente Wolf, me gusta ese módulo...!
-
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.
-
If B1 Then
If D1 = "2" Then DFinal = "DOS"
If D1 = "3" Then DFinal = "TRES"
DFinal = "VEINTI" & DFinal
Else
DFinal = "VEINTE" 'solo lo coloque en mayuscula
End If
Con eso aparece siempre en mayuscula al igual que el resto...
-
Hola, de nuevo, mi comentario fue para que el autor EDITARA su mensaje y lo corrigiera para aquel que después lo utilice. También he corregido el "SETECINETOS " por "SETECIENTOS", igualmente lo comento por si Wolf desea modificarlo.
Saludos
-
Graxias SSCCAANN !!!
Y si el Veinte esta en minusculas, lo deje asi por alguna razon pero ya no recuerdo por que!!!! :P
Pero esta documentado si los decimales no te sale bien entonces busca en la seccion de los decimales y los centesimos y modificalo a tu gusto
-
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
En lo personal yo estoy totalmente de acuerdo en poner UN MIL. Así lo hago desde hace años. ¿La razón? no estamos hablando de números silvestres cuales quiera, estamos hablando de montos, al poner UN MIL elimino cualquier posibilidad de alteración del documento de que alguien agregue por ejemplo en letras DOS MIL. Claro con alguna artimaña de algún competente estafador tambien podría alterarlo, pero al menos se la hace mucho mas complicado.
Una vez hace un par de años por una historia larga que no voy a contar, un cliente mio en un contrato le alteraron el monto, era de algo asi como 1,250 Nuevos Soles (Peru) y en letras: MIL DOSCIENTOS CINCUENTA NUEVOS SOLES.
Lamentablemente al estar hecho a mano entre el 1 y la coma había un ligero espacio y cambiaron por 10,250 y en letras fácil DIEZ MIL DOSCIENTOS CINCUENTA NUEVOS SOLES. Afortunadamente la estafa no se concreto pero retraso mucho el tramite que de haber puesto 1,250 y en letras UN MIL DOSC... no hubiera perdido tiempo alguno.
Insisto es una sugerencia, no pretendo crear polémica
A y ademas acá en Perú tampoco decimos UN MIL algo, decimos MIL pero en documentos con montos escribimos UN MIL.
Buena ssccaann43
-
No tengo problemas en el UN MIL y en el MIL pero si haces lo siguiente:
SON: MIL DOSCIENTOS CINCUENTA QUETZALES CON SETENTA Y CINCO CENTAVOS
creo que hay no hay forma de que te cometan fraude con algun documento
y si por parte es un cheque, yo lo que hago con mis clientes es configurar el reporte para que cuando pida la cifra se imprima pegado ejemplo
CANTIDAD EN NUMEROS: Q. 1250.00
CANTIDAD EN LETRAS: MIL DOSCIENTOS CINCUENTA QUETZALES EXACTOS
y pues asi lo he solucionado de tal manera que el cheque se mira mas estetico y no se puede plagiar. en cuanto a las correciones, bueno graxias no las habia notado ya corregi el del VEINTE pero no habia visto el de SETECIENTOS
Graxias lo corrigo y lo modifico :P
-
Bueno Yo Utilizo esta Funcion
Esto va en un modulo
Dim Numeros(103) As String
Function Centenas(VCentena As Double) As String
If VCentena = 1 Then
Centenas = Numeros(100)
Else
If VCentena = 5 Then
Centenas = Numeros(101)
Else
If VCentena = 7 Then
Centenas = letras & Numeros(102)
Else
If VCentena = 9 Then
Centenas = letras & Numeros(103)
Else
Centenas = Numeros(VCentena)
End If
End If
End If
End If
End Function
Function Unidades(VUnidad As Double) As String
Unidades = Numeros(VUnidad)
End Function
Function Decenas(VDecena As Double) As String
Decenas = Numeros(VDecena)
End Function
Sub inicializar()
Numeros(0) = "CERO"
Numeros(1) = "UNO"
Numeros(2) = "DOS"
Numeros(3) = "TRES"
Numeros(4) = "CUATRO"
Numeros(5) = "CINCO"
Numeros(6) = "SEIS"
Numeros(7) = "SIETE"
Numeros(8) = "OCHO"
Numeros(9) = "NUEVE"
Numeros(10) = "DIEZ"
Numeros(11) = "ONCE"
Numeros(12) = "DOCE"
Numeros(13) = "TRECE"
Numeros(14) = "CATORCE"
Numeros(15) = "QUINCE"
Numeros(20) = "VEINTE"
Numeros(30) = "TREINTA"
Numeros(40) = "CUARENTA"
Numeros(50) = "CINCUENTA"
Numeros(60) = "SESENTA"
Numeros(70) = "SETENTA"
Numeros(80) = "OCHENTA"
Numeros(90) = "NOVENTA"
Numeros(100) = "CIENTO"
Numeros(101) = "QUINIENTOS"
Numeros(102) = "SETECIENTOS"
Numeros(103) = "NOVECIENTOS"
End Sub
Function NumerosALetras(Numero As Double, Valor2 As Boolean) As String
Dim letras As String
Dim HuboCentavos As Boolean
Dim Decimales As Double
Decimales = Numero - Int(Numero)
Numero = Int(Numero)
inicializar
letras = ""
Do
'*---> Validación si se pasa de 100 millones
If Numero >= 1000000000 Then
letras = "Error en Conversión a Letras"
Numero = 0
Decimales = 0
End If
'*---> Centenas de Millón
If (Numero < 1000000000) And (Numero >= 100000000) Then
If (Int(Numero / 100000000) = 1) And ((Numero - (Int(Numero / 100000000) * 100000000)) < 1000000) Then
letras = letras & "CIEN MILLONES "
Else
letras = letras & Centenas(Int(Numero / 100000000))
If (Int(Numero / 100000000) <> 1) And (Int(Numero / 100000000) <> 5) And (Int(Numero / 100000000) <> 7) And (Int(Numero / 100000000) <> 9) Then
letras = letras & "CIENTOS "
Else
letras = letras & " "
End If
End If
Numero = Numero - (Int(Numero / 100000000) * 100000000)
End If
'*---> Decenas de Millón
If (Numero < 100000000) And (Numero >= 10000000) Then
If Int(Numero / 1000000) < 16 Then
letras = letras & Decenas(Int(Numero / 1000000))
letras = letras & " MILLONES "
Numero = Numero - (Int(Numero / 1000000) * 1000000)
Else
letras = letras & Decenas(Int(Numero / 10000000) * 10)
Numero = Numero - (Int(Numero / 10000000) * 10000000)
If Numero > 1000000 Then
letras = letras & " y "
End If
End If
End If
'*---> Unidades de Millón
If (Numero < 10000000) And (Numero >= 1000000) Then
If Int(Numero / 1000000) = 1 Then
letras = letras & " UN MILLÓN "
Else
letras = letras & Unidades(Int(Numero / 1000000))
letras = letras & " MILLONES "
End If
Numero = Numero - (Int(Numero / 1000000) * 1000000)
End If
'*---> Centenas de Millar
If (Numero < 1000000) And (Numero >= 100000) Then
If (Int(Numero / 100000) = 1) And ((Numero - (Int(Numero / 100000) * 100000)) < 1000) Then
letras = letras & "CIEN MIL "
Else
letras = letras & Centenas(Int(Numero / 100000))
If (Int(Numero / 100000) <> 1) And (Int(Numero / 100000) <> 5) And (Int(Numero / 100000) <> 7) And (Int(Numero / 100000) <> 9) Then
letras = letras & "CIENTOS "
Else
letras = letras & " "
End If
End If
Numero = Numero - (Int(Numero / 100000) * 100000)
End If
'*---> Decenas de Millar
If (Numero < 100000) And (Numero >= 10000) Then
If Int(Numero / 1000) < 16 Then
letras = letras & Decenas(Int(Numero / 1000))
letras = letras & " MIL "
Numero = Numero - (Int(Numero / 1000) * 1000)
Else
letras = letras & Decenas(Int(Numero / 10000) * 10)
Numero = Numero - (Int((Numero / 10000)) * 10000)
If Numero > 1000 Then
letras = letras & " y "
Else
letras = letras & " MIL "
End If
End If
End If
'*---> Unidades de Millar
If (Numero < 10000) And (Numero >= 1000) Then
If Int(Numero / 1000) = 1 Then
'' AQUI DECIA letras = letras & "un"
letras = letras & ""
Else
letras = letras & Unidades(Int(Numero / 1000))
End If
letras = letras & " MIL "
Numero = Numero - (Int(Numero / 1000) * 1000)
End If
'*---> Centenas
If (Numero < 1000) And (Numero > 99) Then
If (Int(Numero / 100) = 1) And ((Numero - (Int(Numero / 100) * 100)) < 1) Then
letras = letras & "CIEN "
Else
letras = letras & Centenas(Int(Numero / 100))
If (Int(Numero / 100) <> 1) And (Int(Numero / 100) <> 5) And (Int(Numero / 100) <> 7) And (Int(Numero / 100) <> 9) Then
letras = letras & "CIENTOS "
Else
letras = letras & " "
End If
End If
Numero = Numero - (Int(Numero / 100) * 100)
End If
'*---> Decenas
If (Numero < 100) And (Numero > 9) Then
If Numero < 16 Then
letras = letras & Decenas(Int(Numero))
Numero = Numero - Int(Numero)
Else
letras = letras & Decenas(Int((Numero / 10)) * 10)
Numero = Numero - (Int((Numero / 10)) * 10)
If Numero > 0.99 Then
letras = letras & " y "
End If
End If
End If
'*---> Unidades
If (Numero < 10) And (Numero > 0.99) Then
letras = letras & Unidades(Int(Numero))
Numero = Numero - Int(Numero)
End If
Loop Until (Numero = 0)
'*---> Decimales
If (Decimales > 0) Then
letras = letras & " con "
letras = letras & Format(Decimales * 100, "00") & "/100"
'Else
' If (letras <> "Error en Conversión a Letras") And (Len(Trim(letras)) > 0) Then
' Select Case Valor1
' Case True
' letras = letras & " exactos"
' End Select
' End If
End If
NumerosALetras = letras
Select Case Valor2
Case True
NumerosALetras = UCase(Left(letras, 1)) & Right(letras, Len(letras) - 1)
End Select
End Function
y Esto en el Form
Text2.Text = NumerosALetras(Val(Text1.Text), True) & " Nuevos Soles"
Donde text1 va el numero que va Convertir a letra
text2 es el resultado
-
Interesante, pero tiene un bugsillo, por ejemplo, si pones el numero:
121000 el código entrega el texto:
CIENTO VEINTE MIL MIL Nuevos Soles
101000 el código entrega el texto:
CIENTO MIL Nuevos Soles
Me permitiría hacerle una modificación aun sin mucho estudio pero podemos ir evaluando.
En la parte de las unidades de millar comentaste el odiado "un", cambie el código de esto:
'*---> Unidades de Millar
If (Numero < 10000) And (Numero >= 1000) Then
If Int(Numero / 1000) = 1 Then
'' AQUI DECIA letras = letras & "un"
letras = letras & ""
Else
letras = letras & Unidades(Int(Numero / 1000))
End If
letras = letras & " MIL "
Numero = Numero - (Int(Numero / 1000) * 1000)
End If
a esto:
'*---> Unidades de Millar
If (Numero < 10000) And (Numero >= 1000) Then
If Int(Numero / 1000) = 1 Then
'' AQUI DECIA letras = letras & "un"
If Right(letras, 4) = "MIL " Then
letras = Mid(letras, 1, Len(letras) - 5) & " UN " ' letras & ""
Else
If Len(letras) > 0 Then letras = letras & "UN " ' letras & ""
End If
Else
letras = letras & Unidades(Int(Numero / 1000))
End If
letras = letras & " MIL "
Numero = Numero - (Int(Numero / 1000) * 1000)
End If
y este código entrara lo siguiente (pueden probarlo)
101000: CIENTO UN MIL Nuevos Soles
121000: CIENTO VEINTE UN MIL Nuevos Soles
Incluso para mis amigos que no les gusta el "UN MIL" al inicio, el numero:
1000 nos dará: MIL Nuevos Soles
1250 nos dará: MIL DOSCIENTOS CINCUENTA Nuevos Soles
Espero sirva. Saludos
y para mis amigos que odia el UN MIL solo habría que validar
-
Hay varios ejemplos de codigo para convertir Monedas a Letras, pero no creen que si es hora de hacer una sección para que todo esto tenga un acceso mas rapido!!!!! ???