(01/Jul/2000) Menudo despiste...
Por equivocación, el link al nuevo código de la clase cNum2Text te enviaba a esta página que es de fecha de 1997 y por supuesto, no tiene las "últimas" modificaciones de esta utilidad de convertir números a letras: la clase cNum2Text.cls, así que sigue el siguiente link para ver la página especial con la última modificación (del 30/Jun/2000) y el formulario de prueba.
Pido disculpas por el despiste.
Aquí tienes el link.
14/Jul) He cambiado el nombre del módulo para que puedas usarlo sin problemas con VB4-16 bits.Esta es una nueva revisión del código antes mostrado, el cual puedes ver si pulsas este link.
En esta nueva revisión, además de algunos BUGS, he modificado para que ahora muestre números con decimales, además de poder mostrar una palabra sobre la moneda así como para la palabra usada para los céntimos.
(Aunque además habría que cambiar el SEXO de las palabras, ya que lo tengo hecho para LA PESETA)En el form de prueba puedes ver cómo funciona todo esto y de camino sirve para chequear.
Decir que el valor máximo aceptado es: 999.999.999.999,99
Si alguien se atreve a modificar la función para que trate los decimales... ¡ADELANTE! y por supuesto que me la haga llegar.Estos son los listados del módulo en el que se encuentra la función y una "captura" del form de prueba.
Pulsa en este link para bajar los listados y el form de prueba (num2txt.zip 4.49 KB)
(
'----------------------------------------------------------------- ' gsNumero.BAS Módulo para procedimientos numéricos ( 1/Mar/91) ' Versión para Windows (25/Oct/96) ' ' Última revisión: (10/Jul/97) ' '(c)Guillermo Som, 1991-97 '----------------------------------------------------------------- Option Explicit Option Compare Text 'Declaradas a nivel de módulo Dim unidad(0 To 9) As String Dim decena(0 To 9) As String Dim centena(0 To 10) As String Dim deci(0 To 9) As String Dim otros(0 To 15) As String
Private Sub InicializarArrays() 'Asignar los valores unidad(1) = "una" unidad(2) = "dos" unidad(3) = "tres" unidad(4) = "cuatro" unidad(5) = "cinco" unidad(6) = "seis" unidad(7) = "siete" unidad(8) = "ocho" unidad(9) = "nueve" ' decena(1) = "diez" decena(2) = "veinte" decena(3) = "treinta" decena(4) = "cuarenta" decena(5) = "cincuenta" decena(6) = "sesenta" decena(7) = "setenta" decena(8) = "ochenta" decena(9) = "noventa" ' centena(1) = "ciento" centena(2) = "doscientas" centena(3) = "trescientas" centena(4) = "cuatrocientas" centena(5) = "quinientas" centena(6) = "seiscientas" centena(7) = "setecientas" centena(8) = "ochocientas" centena(9) = "novecientas" centena(10) = "cien" 'Parche ' deci(1) = "dieci" deci(2) = "veinti" deci(3) = "treinta y " deci(4) = "cuarenta y " deci(5) = "cincuenta y " deci(6) = "sesenta y " deci(7) = "setenta y " deci(8) = "ochenta y " deci(9) = "noventa y " ' otros(1) = "1" otros(2) = "2" otros(3) = "3" otros(4) = "4" otros(5) = "5" otros(6) = "6" otros(7) = "7" otros(8) = "8" otros(9) = "9" otros(10) = "10" otros(11) = "once" otros(12) = "doce" otros(13) = "trece" otros(14) = "catorce" otros(15) = "quince" End Sub
Public Function Numero2Letra(ByVal strNum As String, Optional ByVal vLo, Optional ByVal vMoneda, Optional ByVal vCentimos) As String '---------------------------------------------------------- ' Convierte el número strNum en letras (28/Feb/91) ' Versión para Windows (25/Oct/96) ' Variables estáticas (15/May/97) ' Parche de "Esteve" <[email protected]> (20/May/97) ' Revisión para decimales (10/Jul/97) '---------------------------------------------------------- Dim i As Integer Dim Lo As Integer Dim iHayDecimal As Integer 'Posición del signo decimal Dim sDecimal As String 'Signo decimal a usar Dim sEntero As String Dim sFraccion As String Dim fFraccion As Single Dim sNumero As String ' Dim sMoneda As String Dim sCentimos As String 'Si se especifica, se usarán If Not IsMissing(vMoneda) Then sMoneda = " " & Trim$(vMoneda) & " " Else sMoneda = " " End If If Not IsMissing(vCentimos) Then sCentimos = " " & Trim$(vCentimos) End If 'Averiguar el signo decimal sNumero = Format$(25.5, "#.#") If InStr(sNumero, ".") Then sDecimal = "." Else sDecimal = "," End If 'Si no se especifica el ancho... If IsMissing(vLo) Then Lo = 0 Else Lo = vLo End If ' If Lo Then sNumero = Space$(Lo) Else sNumero = "" End If 'Quitar los espacios que haya por medio Do i = InStr(strNum, " ") If i = 0 Then Exit Do strNum = Left$(strNum, i - 1) & Mid$(strNum, i + 1) Loop 'Comprobar si tiene decimales iHayDecimal = InStr(strNum, sDecimal) If iHayDecimal Then sEntero = Left$(strNum, iHayDecimal - 1) sFraccion = Mid$(strNum, iHayDecimal + 1) & "00" 'obligar a que tenga dos cifras sFraccion = Left$(sFraccion, 2) fFraccion = Val(sFraccion) 'Si no hay decimales... no agregar nada... If fFraccion < 1 Then strNum = RTrim$(UnNumero(sEntero) & sMoneda) If Lo Then LSet sNumero = strNum Else sNumero = strNum End If Numero2Letra = sNumero Exit Function End If sEntero = UnNumero(sEntero) sFraccion = UnNumero(sFraccion) ' strNum = sEntero & sMoneda & "con " & sFraccion & sCentimos If Lo Then LSet sNumero = RTrim$(strNum) Else sNumero = RTrim$(strNum) End If Numero2Letra = sNumero Else strNum = RTrim$(UnNumero(strNum) & sMoneda) If Lo Then LSet sNumero = strNum Else sNumero = strNum End If Numero2Letra = sNumero End If End Function
Private Function UnNumero(ByVal strNum As String) As String '---------------------------------------------------------- 'Esta es la rutina principal (10/Jul/97) 'Está separada para poder actuar con decimales '---------------------------------------------------------- Dim lngA As Double Dim Negativo As Boolean Dim L As Integer Dim Una As Boolean Dim Millon As Boolean Dim Millones As Boolean Dim vez As Integer Dim MaxVez As Integer Dim k As Integer Dim strQ As String Dim strB As String Dim strU As String Dim strD As String Dim strC As String Dim iA As Integer ' Dim strN() As String 'Si se amplia este valor... no se manipularán bien los números Const cAncho = 12 Const cGrupos = cAncho \ 3 ' If unidad(1) <> "una" Then InicializarArrays End If 'Si se produce un error que se pare el mundo!!! On Local Error GoTo 0 lngA = Abs(CDbl(strNum)) Negativo = (lngA <> CDbl(strNum)) strNum = LTrim$(RTrim$(Str$(lngA))) L = Len(strNum) If lngA < 1 Then UnNumero = "cero" Exit Function End If ' Una = True Millon = False Millones = False If L < 4 Then Una = False If lngA > 999999 Then Millon = True If lngA > 1999999 Then Millones = True strB = "" strQ = strNum vez = 0 ReDim strN(1 To cGrupos) strQ = Right$(String$(cAncho, "0") & strNum, cAncho) For k = Len(strQ) To 1 Step -3 vez = vez + 1 strN(vez) = Mid$(strQ, k - 2, 3) Next MaxVez = cGrupos For k = cGrupos To 1 Step -1 If strN(k) = "000" Then MaxVez = MaxVez - 1 Else Exit For End If Next For vez = 1 To MaxVez strU = "": strD = "": strC = "" strNum = strN(vez) L = Len(strNum) k = Val(Right$(strNum, 2)) If Right$(strNum, 1) = "0" Then k = k \ 10 strD = decena(k) ElseIf k > 10 And k < 16 Then k = Val(Mid$(strNum, L - 1, 2)) strD = otros(k) Else strU = unidad(Val(Right$(strNum, 1))) If L - 1 > 0 Then k = Val(Mid$(strNum, L - 1, 1)) strD = deci(k) End If End If '---Parche de Esteve If L - 2 > 0 Then k = Val(Mid$(strNum, L - 2, 1)) 'Con esto funcionará bien el 100100, por ejemplo... If k = 1 Then 'Parche If Val(strNum) = 100 Then 'Parche k = 10 'Parche End If 'Parche End If strC = centena(k) & " " End If '------ If strU = "uno" And Left$(strB, 4) = " mil" Then strU = "" strB = strC & strD & strU & " " & strB If (vez = 1 Or vez = 3) Then If strN(vez + 1) <> "000" Then strB = " mil " & strB End If If vez = 2 And Millon Then If Millones Then strB = " millones " & strB Else strB = "un millón " & strB End If End If Next strB = Trim$(strB) If Right$(strB, 3) = "uno" Then strB = Left$(strB, Len(strB) - 1) & "a" Do 'Quitar los espacios que haya por medio iA = InStr(strB, " ") If iA = 0 Then Exit Do strB = Left$(strB, iA - 1) & Mid$(strB, iA + 1) Loop If Left$(strB, 6) = "una un" Then strB = Mid$(strB, 5) If Left$(strB, 7) = "una mil" Then strB = Mid$(strB, 5) If Right$(strB, 16) <> "millones mil una" Then iA = InStr(strB, "millones mil una") If iA Then strB = Left$(strB, iA + 8) & Mid$(strB, iA + 13) End If If Right$(strB, 6) = "ciento" Then strB = Left$(strB, Len(strB) - 2) If Negativo Then strB = "menos " & strB UnNumero = Trim$(strB) End Function