(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
