Como puedes comprobar por el título, en esta página te hablaré de dos
clases:
cCambio Para
efectuar cambios y
cNum2Text Para convertir números a
letras, (ya estaba antes publicado, al
menos eso creía yo)
Nota del 01/Jul/2000:
Este es el link
a la versión del 30/Jun/2000 de cNum2Text.cls
Nota: Estas dos clases están incluidas en la librería gsAxDLL
Esta clase la he hecho para "atacar" el tema del Euro, que es el que está ahora empezando a dar quebraderos de cabeza al personal, (al menos en España y algunos paises de Europa).
Realmente la clase vale para cualquier tipo de moneda, no sólo para el Euro, pero...
Vamos a dejar a un lado los motivos de la creación de esta clase y vamos a ver que es lo que puede hacer, para que así evalues si te puede ser útil o no.
La clase contiene una colección de Monedas,
cada moneda (o elemento de la colección), tiene estas propiedades:
Nombre Nombre en singular de la moneda
Cambio Cambio con respecto a la moneda base de la
clase, en esta implementación es el Euro.
Simbolo Símbolo usado para representar a la moneda
Sexo Sexo de la moneda, esto es
útil si se usa para mostrar el número en letras.
Al iniciarse la clase, se crean una serie de monedas con sus respectivos cambios, la fecha de cotización es la del viernes 8 de Enero de 1999, por tanto para las monedas que no estén dentro de la Zona Euro, se deberían ajustar al cambio actual, ya que las monedas de la Zona Euro, tendrán ese valor fijo hasta que desaparezcan el 1 de Julio del 2002.
Además de la colección Monedas, existe un método que es el que se encarga de realizar el cambio y como podrás imaginarte, el nombre de ese método se llama Cambio.
Ahora veremos un ejemplo de cómo usarla, pero antes vamos a ver el listado de las tres clases que son necesarias para la clase cCambio: la propia clase cCambio, cMoneda y cMonedas:
cMoneda es la clase base de la colección cMonedas y tiene las propiedades que se mencionaron más arriba.
'----------------------------------------------------------------------------------
'cMoneda Clase básica para la colección Monedas (10/Ene/99)
'
'©Guillermo 'guille' Som, 1999
'----------------------------------------------------------------------------------
Option Explicit
Private m_Nombre As String
Public Cambio As Double
Public Simbolo As String
Public Sexo As eCambioSexo ' Añadido el 13/Ene/99 para usarlo con cNum2Text
'Esta enumeración está también en Num2Text
'pero tiene otro nombre para que no de problemas de "ambigüedad",
'aunque los valores son los mismos
Public Enum eCambioSexo
Female '= 0
Male '= 1
End Enum
Public Property Get Nombre() As String
Nombre = m_Nombre
End Property
Public Property Let Nombre(ByVal NewValue As String)
'No permitir que se modifique una vez asignada
Static bYaEstoy As Boolean
If Not bYaEstoy Then
bYaEstoy = True
m_Nombre = NewValue
End If
End Property
Private Sub Class_Initialize()
Sexo = Female
End Sub
cMonedas: Esta clase es realmente una colección del tipo cMoneda y es la que se encarga de mantener la colección, los métodos que dispone son los habituales en una colección, además del método Clear que sirve para borrar el contenido de la colección y Find que busca un elemento en la colección y permite crearlo si así se le especifica.
Nota: Te recomiendo que "estudies" un poco cómo funcionan los métodos Item, Add y Find, sobre todo Add.
Veamos el código:
'----------------------------------------------------------------------------------
'cMonedas, colección del tipo cMoneda (10/Ene/99)
'
'©Guillermo Som, 1999
'----------------------------------------------------------------------------------
Option Explicit
Private m_col As Collection
Public Sub Clear()
'Borrar el contenido de la colección
Set m_col = Nothing
Set m_col = New Collection
End Sub
Public Function NewEnum() As IUnknown
'Debe ser un miembro oculto y
'el id del procedimiento debe ser -4
'
Set NewEnum = m_col.[_NewEnum]
End Function
Public Sub Remove(ByVal Index As Variant)
'Método Remove de una colección
On Local Error Resume Next
m_col.Remove Index
Err = 0
End Sub
Public Function Item(ByVal Index As Variant) As cMoneda
'Método Item de una colección.
'Asignarlo como método predeterminado
Dim tMoneda As cMoneda
'Iniciamos la detección de errores
On Local Error Resume Next
Set Item = m_col.Item(Index)
If Err Then
'no existe ese elemento
Err = 0
'Creamos una nueva referencia
Set tMoneda = New cMoneda
tMoneda.Nombre = Index
'lo añadimos a la colección
m_col.Add tMoneda, tMoneda.Nombre
Set Item = tMoneda
'Eliminamos el objeto
Set tMoneda = Nothing
End If
'Dejamos de capturar los errores
Err = 0
On Error GoTo 0
End Function
Public Function Count() As Long
'Método Count de las colección
Count = m_col.Count
End Function
Public Sub Add(ByVal Item As Variant, _
Optional ByVal Key As Variant, _
Optional ByVal Before As Variant, _
Optional ByVal After As Variant)
'Añadir un nuevo elemento a la colección
'Si ese elemento ya existe se sustituye por el valor indicado (10/Ene/99)
Dim tMoneda As cMoneda
On Local Error Resume Next
'Si el parámetro Item es del tipo cMoneda
If TypeOf Item Is cMoneda Then
'Asignar ese elemento a tMoneda
Set tMoneda = Item
Else
'Crear una nueva
Set tMoneda = New cMoneda
'Si no se especifica el key
If IsMissing(Key) Then
'Asignar el Item al Nombre
tMoneda.Nombre = Item
Else
tMoneda.Nombre = Key
tMoneda.Cambio = Item
End If
End If
'Usar siempre el Nombre como clave de este elemento
m_col.Add tMoneda, tMoneda.Nombre, Before, After
If Err Then
'ya existe
'borrarla y añadirla de nuevo
m_col.Remove tMoneda.Nombre
m_col.Add tMoneda, tMoneda.Nombre, Before, After
End If
Set tMoneda = Nothing
Err = 0
On Error GoTo 0
End Sub
Private Sub Class_Initialize()
Set m_col = New Collection
End Sub
Private Sub Class_Terminate()
Set m_col = Nothing
End Sub
Public Function Find(ByVal Nombre As String, _
Optional ByVal Crear As Boolean = False) As cMoneda
'Busca un Moneda con el Nombre indicado
'si lo encuentra devuelve el objeto del tipo cMoneda,
'si no lo encuentra:
' si se especifica Crear, devuelve un nuevo elemento
' si no se especifica Crear devuelve Nothing
Dim tMonedaHallada As cMoneda
On Local Error Resume Next
Set tMonedaHallada = m_col(Nombre)
If Err Then
If Crear Then
'crearlo
Set tMonedaHallada = New cMoneda
With tMonedaHallada
.Nombre = Nombre
End With
m_col.Add tMonedaHallada, tMonedaHallada.Nombre
End If
End If
Set Find = tMonedaHallada
Err = 0
On Local Error GoTo 0
End Function
cCambio: esta es la clase
"expuesta", o sea que es la que se debe crear para poder efectuar el
cambio y acceder a la colección Monedas.
Esta clase tiene una colección Monedas del tipo cMonedas y una propiedad
MonedaBase que es de sólo lectura y nos informa del nombre de la moneda base;
el método Cambio es el que se encarga de efectuar el cambio de una moneda a
otra. Por supuesto, las monedas que intervienen en el cambio deben estar
contenidas en la colección Monedas.
Veamos el código:
'----------------------------------------------------------------------------------
'cCambio Clase para efectar cambios de una moneda a otra (10/Ene/99)
'
'©Guillermo 'guille' Som, 1999
'
'Esta clase servirá para efectuar cálculos sobre cambios de una moneda a otra.
'Todos los cambios se basarán en la moneda base, por defecto el Euro.
'Existirá una colección de Monedas con el nombre y el cambio con respecto a la
'moneda base.
'
'Propiedades y métodos:
' MonedaBase Devuelve el nombre de la moneda base (Euro)
' Monedas Colección de monedas con las siguientes propiedades:
' .Nombre Nombre de la moneda
' .Simbolo Símbolo usado para representarla
' .Cambio Cambio con respecto a la moneda base
' .Sexo Sexo de la moneda (para usar con Num2Text)
' Cambio Efectúa un cambio de una moneda a otra
'----------------------------------------------------------------------------------
Option Explicit
Private colMonedas As cMonedas
Const cMonedaBase = "Euro"
Const cPeseta = "Peseta"
Public Property Get MonedaBase() As String
'Devuelve el nombre de la moneda base (por defecto Euro)
MonedaBase = cMonedaBase
End Property
Public Function Monedas() As cMonedas
'Devuelve la colección Monedas
Set Monedas = colMonedas
End Function
Private Sub Class_Initialize()
Set colMonedas = New cMonedas
'Esta moneda debe estar en la colección
With Monedas(cMonedaBase)
.Simbolo = "€" 'se consigue pulsando AltGr+E o Ctrl+Alt+5
.Cambio = 1
.Sexo = Male
End With
'Algunos cambios de las monedas de la Zona Euro
'Estos cambios ya son fijos
With Monedas(cPeseta)
.Cambio = 166.386 'El importe de un Euro
.Simbolo = "Pta"
.Sexo = Female
End With
With Monedas("Marco")
.Cambio = 1.95583
.Simbolo = "DM"
.Sexo = Male
End With
With Monedas("Escudo")
.Cambio = 200.482
.Simbolo = "Es"
.Sexo = Male
End With
With Monedas("Franco")
.Cambio = 6.55957
.Simbolo = "Fr"
.Sexo = Male
End With
With Monedas("Lira")
.Cambio = 1936.27
.Simbolo = "L"
.Sexo = Female
End With
'Otros cambios de la Zona Euro:
'Franco Belga: 40.3399
'Florin Holandés: 2.20371
'Chelin Austriaco: 13.7603
'Marco Finlandés: 5.94573
'Libra Irlandesa: 0.787564
'
'Algunos cambios de monedas que no están en la Zona Euro a fecha 08/Ene/99
With Monedas("Dolar")
.Cambio = 1.1632
.Simbolo = "$"
.Sexo = Male
End With
'
With Monedas("Libra")
.Cambio = 0.70585
.Simbolo = "£"
.Sexo = Female
End With
End Sub
Private Sub Class_Terminate()
Set colMonedas = Nothing
End Sub
Public Function Cambio(ByVal Importe As String, _
Optional ByVal Moneda_De As String = cPeseta, _
Optional ByVal Moneda_A As String = cMonedaBase) As Double
'Los parámetros son:
' Importe Importe de la moneda a convertir
' Moneda_De Moneda que se quiere convertir
' Por defecto la Peseta
' Moneda_A Moneda a la que se quiere convertir
' Por defecto el Euro
'Devuelve el importe resultante en la Moneda_A
'
Dim dblCambio1 As Double
Dim dblCambio2 As Double
Dim sTmp As String
On Local Error Resume Next
sTmp = ""
dblCambio1 = Me.Monedas.Find(Moneda_De).Cambio
If Err Then
sTmp = "No existe la moneda '" & Moneda_De & "'" & vbCrLf
Err = 0
End If
dblCambio2 = Me.Monedas.Find(Moneda_A).Cambio
If Err Then
sTmp = sTmp & "No existe la moneda '" & Moneda_A & "'"
End If
If Len(sTmp) Then
On Local Error GoTo 0
Err.Raise 5, "cCambio", sTmp
Else
dblCambio1 = Importe / dblCambio1
'Para que devuelva tres decimales
Cambio = CDbl(Format$(dblCambio1 * dblCambio2, "#,###.###"))
End If
Err = 0
On Local Error GoTo 0
End Function
Bien, estas son las clases que componen cCambio.
Ahora veamos un ejemplo de cómo usarla.
Y este es el código de este programilla de prueba:
'
'Fornmulario de prueba para cCambio (13/Ene/99)
Option Explicit
Private m_Cambio As cCambio
Private Sub cmdCambio_Click()
Dim sMonedaDe As String
Dim sMonedaA As String
Dim dblImporte As String
Dim dblCambio As Double
Dim i As Long
Dim tNum2Text As cNum2Text
Dim sTmp As String
Set tNum2Text = New cNum2Text
' Convertir de forma correcta el tipo de decimal
' corrige algunos errores e incongruencias, aunque no todos...
dblImporte = tNum2Text.ConvDecimal(txtCambio)
With cboMoneda(0)
i = .ListIndex
sMonedaDe = .List(i)
End With
With cboMoneda(1)
i = .ListIndex
sMonedaA = .List(i)
End With
' El método Cambio es el métodor por defecto
'dblCambio = m_Cambio(dblImporte, sMonedaDe, sMonedaA)
dblCambio = m_Cambio.Cambio(dblImporte, sMonedaDe, sMonedaA)
lblCambio(0) = dblImporte & " " & m_Cambio.Monedas(sMonedaDe).Simbolo & " son " & _
dblCambio & " " & m_Cambio.Monedas(sMonedaA).Simbolo
With m_Cambio.Monedas(sMonedaDe)
sTmp = tNum2Text.Numero2Letra(dblImporte, 0, 4, .Nombre, , .Sexo) & " son " & vbCrLf
End With
With m_Cambio.Monedas(sMonedaA)
sTmp = sTmp & tNum2Text.Numero2Letra(dblCambio, 0, 4, .Nombre, , .Sexo)
End With
lblCambio(5) = sTmp
Set tNum2Text = Nothing
End Sub
Private Sub Form_Load()
Dim tMoneda As cMoneda ' Variable del tipo moneda para usar en el bucle
Dim sNombre As String
' Crear el objeto
Set m_Cambio = New cCambio
' Limpiar los combos y el listbox
cboMoneda(0).Clear
cboMoneda(1).Clear
List1.Clear
' Si se quieren añadir algunas monedas, hacerlo ahora
' el Cambio siempre es referente al Euro
'
With m_Cambio.Monedas("Dolar Canadiense")
.Simbolo = "$"
.Cambio = 1.7602
.Sexo = Male
End With
' De esta forma se sustituye, pero se pierde el Símbolo
'm_Cambio.Monedas.Add 1.7602, "Dolar Canadiense"
' Añadir las monedas a los combos y el ListBox
sNombre = Space$(12) '12 caracteres para el nombre a mostrar en el ListBox
' Recorrer todas las monedas de la colección
For Each tMoneda In m_Cambio.Monedas
With tMoneda
cboMoneda(0).AddItem .Nombre
cboMoneda(1).AddItem .Nombre
LSet sNombre = .Nombre
List1.AddItem sNombre & vbTab & .Cambio
End With
Next
' Para probar la devolución de error
'cboMoneda(0).AddItem "Lira"
cboMoneda(0).ListIndex = 0
cboMoneda(1).ListIndex = 1
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set m_Cambio = Nothing
Set frmCambio = Nothing
End Sub
Private Sub txtCambio_GotFocus()
With txtCambio
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub
Espero que los listados estén lo suficientemente claros como para no necesitar más explicación, aunque debería darla, pero eso lo dejo para "el cursillo", que sino, ¿que voy a escribir en él?
Ahora le toca el turno a:
Nota del 01/Jul/2000: Sigue este link para ver el código actualizado al 30/Jun/2000
Como te comenté antes, está basada en la
función que ya publiqué en su día, pero además de estar
"encapsulada" en un módulo de clase, tiene algunas mejoras:
Reconoce
el sexo de la moneda (realmente no lo reconoce, sino que usa el
que le digamos)
Se le pude indicar cuantos decimales queremos usar, antes sólo eran dos.
Si se quiere, se le puede indicar también el sexo de los céntimos, aunque no
se si en estos hay cambio de sexo como en el nombre de la moneda, pero... ahí
está.
|
Por supuesto que se puede usar sin indicar el
nombre de la moneda ni de los céntimos ni el sexo ni nada de nada, pero si no
se hace, funciona como la anterior, es decir: usa el sexo femenino y dos
decimales.
Esto lo he dejado así, para que la forma de llamar a la función que se encarga
de hacer la conversión, sea compatible con la función que había en el módulo
BAS.
Nota: Si quieres ver algunos ejemplo de cómo usar la clase, además de los que hay en la aplicación de cambio de moneda, puedes ver los que hay en los ejemplos y en la ayuda de la librería gsAxDLL
Vamos a ver el código de cNum2Text:
'----------------------------------------------------------------------------------
'cNumero2Letra clase para convertir números a letras 4/Ene/99)
'
'Versión original para MS-DOS: ( 1/Mar/91)
'Versión para Windows (25/Oct/96)
'Última revisión: (10/Jul/97)
'Para manejar el sexo de la moneda y los céntimos ( 6/Ene/99)
'Añado la función ConvDecimal (10/Ene/99)
'Quitados los ceros a la derecha de los decimales (13/Ene/99)
'
'©Guillermo 'guille' Som, 1991-99
'----------------------------------------------------------------------------------
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 m_Sexo1 As String
Private m_Sexo2 As String
Private m_LenSexo1 As Long
Public Enum eSexo
Femenino '= 0
Masculino '= 1
End Enum
Public Function Numero2Letra(ByVal strNum As String, _
Optional ByVal Lo As Long = 0&, _
Optional ByVal NumDecimales As Long = 2&, _
Optional ByVal sMoneda As String = "", _
Optional ByVal sCentimos As String = "", _
Optional ByVal SexoMoneda As eSexo = Femenino, _
Optional ByVal SexoCentimos As eSexo = Masculino) 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)
' Permite indicar el sexo de la moneda ( 6/Ene/99)
' y de los centimos... nunca se sabe...
' Corregido fallo de los decimales cuando (13/Ene/99)
' tienen ceros a la derecha.
'
' La moneda debe especificarse en singular, ya que la función
' se encarga de convertirla en plural.
' Se puede indicar el número de decimales a devolver
' por defecto son dos.
'----------------------------------------------------------
Dim i As Long
Dim iHayDecimal As Long 'Posición del signo decimal
Dim sDecimal As String 'Signo decimal a usar
Dim sDecimalNo As String 'Signo no decimal
Dim sEntero As String
Dim sFraccion As String
Dim fFraccion As Single
Dim sNumero As String
Static SexoAntMoneda As eSexo
Static SexoAntCentimos As eSexo
'
'Dependiendo del "sexo" indicado, usar las terminaciones
If SexoMoneda = Femenino Then
m_Sexo1 = "a"
m_Sexo2 = "as"
Else
m_Sexo1 = ""
m_Sexo2 = "os"
End If
'por si se cambia en el trascurso el sexo de la moneda
If SexoMoneda <> SexoAntMoneda Then
unidad(2) = ""
SexoAntMoneda = SexoMoneda
End If
m_LenSexo1 = Len(m_Sexo1)
'Si se especifica, se usarán
sMoneda = Trim$(sMoneda)
If Len(Trim$(sMoneda)) Then
sMoneda = " " & sMoneda & " "
Else
sMoneda = " "
End If
sCentimos = Trim$(sCentimos)
If Len(Trim$(sCentimos)) Then
sCentimos = " " & sCentimos & " "
Else
sCentimos = " "
End If
'Si no se especifica el ancho...
'
If Lo Then
sNumero = Space$(Lo)
Else
sNumero = ""
End If
'Comprobar el signo decimal y devolver los adecuados a la config. regional
strNum = ConvDecimal(strNum, sDecimal, sDecimalNo)
'Comprobar si tiene decimales
iHayDecimal = InStr(strNum, sDecimal)
If iHayDecimal Then
sEntero = Left$(strNum, iHayDecimal - 1)
sFraccion = Mid$(strNum, iHayDecimal + 1) & String$(NumDecimales, "0")
'obligar a que tenga dos cifras
'
'pero habría que redondear el resto...
'por ejemplo:
' .256 sería .26 y
' .254 sería .25
'Pero esto otro no se haría:
'.25499 no pasaría a .255 y después a .26
'
sFraccion = Left$(sFraccion, NumDecimales + 1)
fFraccion = Int((Val(sFraccion) / 100) * 10 + 0.5) * 10
sFraccion = Left$(CStr(fFraccion), NumDecimales)
'En las fracciones los ceros a la derecha no tienen significado
Do While Right$(sFraccion, 1) = "0"
sFraccion = Left$(sFraccion, Len(sFraccion) - 1)
Loop
fFraccion = Val(sFraccion)
'Si no hay decimales... no agregar nada...
If fFraccion < 1 Then
If Len(Trim$(sMoneda)) Then
sMoneda = Pluralizar(sNumero, sMoneda)
End If
strNum = RTrim$(UnNumero(sEntero, m_Sexo1) & sMoneda)
If Lo Then
LSet sNumero = strNum
Else
sNumero = strNum
End If
Numero2Letra = sNumero
Exit Function
End If
If Len(Trim$(sMoneda)) Then
sMoneda = Pluralizar(sEntero, sMoneda)
End If
sEntero = UnNumero(sEntero, m_Sexo1)
If Len(Trim$(sCentimos)) Then
sCentimos = Pluralizar(sFraccion, sCentimos)
End If
'Para el sexo de los decimales
'no se si esto puede cambiar, pero por si ocurre...
If SexoCentimos = Masculino Then
sFraccion = UnNumero(sFraccion, "")
Else
sFraccion = UnNumero(sFraccion, "a")
End If
'
strNum = sEntero & sMoneda & "con " & sFraccion & sCentimos
If Lo Then
LSet sNumero = RTrim$(strNum)
Else
sNumero = RTrim$(strNum)
End If
Numero2Letra = sNumero
Else
If Len(Trim$(sMoneda)) Then
sMoneda = Pluralizar(strNum, sMoneda)
End If
strNum = RTrim$(UnNumero(strNum, m_Sexo1) & 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, ByVal Sexo1 As String) As String
'----------------------------------------------------------
'Esta es la rutina principal (10/Jul/97)
'Está separada para poder actuar con decimales
'----------------------------------------------------------
Dim dblNumero 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 Long
Dim MaxVez As Long
Dim k As Long
Dim strQ As String
Dim strB As String
Dim strU As String
Dim strD As String
Dim strC As String
Dim iA As Long
'
Dim strN() As String
Dim Sexo1Ant As String
'Si se amplia este valor... no se manipularán bien los números
Const cAncho = 12
Const cGrupos = cAncho \ 3
'Por si se especifica el sexo, para el caso de los decimales
'que siempre será masculino
Sexo1Ant = m_Sexo1
m_Sexo1 = Sexo1
If m_Sexo1 <> Sexo1Ant Then
unidad(2) = ""
End If
m_LenSexo1 = Len(m_Sexo1)
'
'idea aportada por Harvey Triana
'para no tener que estar reinicializando continuamente los arrays
If unidad(2) <> "dos" Then
InicializarArrays
End If
'Si se produce un error que se pare el mundo!!!
On Local Error GoTo 0
If Len(strNum) = 0 Then
strNum = "0"
End If
dblNumero = Abs(CDbl(strNum))
Negativo = (dblNumero <> CDbl(strNum))
strNum = LTrim$(RTrim$(Str$(dblNumero)))
L = Len(strNum)
If dblNumero < 1 Then
UnNumero = "cero"
Exit Function
End If
'
Una = True
Millon = False
Millones = False
If L < 4 Then Una = False
If dblNumero > 999999 Then Millon = True
If dblNumero > 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) & m_Sexo1 '"a"
End If
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, 5 + m_LenSexo1) = "un" & m_Sexo1 & " un" Then
strB = Mid$(strB, 4 + m_LenSexo1)
End If
If Left$(strB, 6 + m_LenSexo1) = "un" & m_Sexo1 & " mil" Then
strB = Mid$(strB, 4 + m_LenSexo1)
End If
If Right$(strB, 15 + m_LenSexo1) <> "millones mil un" & m_Sexo1 Then
iA = InStr(strB, "millones mil un" & m_Sexo1)
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)
End If
If Negativo Then strB = "menos " & strB
UnNumero = Trim$(strB)
'Restablecer el valor anterior
m_Sexo1 = Sexo1Ant
m_LenSexo1 = Len(m_Sexo1)
End Function
Private Sub InicializarArrays()
'Asignar los valores
unidad(1) = "un" & m_Sexo1
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) = "doscient" & m_Sexo2
centena(3) = "trescient" & m_Sexo2
centena(4) = "cuatrocient" & m_Sexo2
centena(5) = "quinient" & m_Sexo2
centena(6) = "seiscient" & m_Sexo2
centena(7) = "setecient" & m_Sexo2
centena(8) = "ochocient" & m_Sexo2
centena(9) = "novecient" & m_Sexo2
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
Private Sub Class_Initialize()
m_Sexo1 = "a"
m_Sexo2 = "as"
End Sub
Private Function Pluralizar(ByVal sNumero As String, ByVal sMoneda As String) As String
Dim dblTotal As Double
If Len(Trim$(sMoneda)) Then
dblTotal = Val(sNumero)
If dblTotal <> 1# Then
sMoneda = Trim$(sMoneda)
If InStr("aeiou", Right$(sMoneda, 1)) Then
sMoneda = " " & sMoneda & "s "
Else
sMoneda = " " & sMoneda & "es "
End If
End If
End If
Pluralizar = sMoneda
End Function
Public Function ConvDecimal(ByVal strNum As String, _
Optional ByRef sDecimal As String = ",", _
Optional ByRef sDecimalNo As String = ".") As String
'Asigna el signo decimal adecuado (o lo intenta) (10/Ene/99)
'Devuelve una cadena con el signo decimal del sistema
Dim sNumero As String
Dim i As Long
Dim j As Long
'Averiguar el signo decimal
sNumero = Format$(25.5, "#.#")
If InStr(sNumero, ".") Then
sDecimal = "."
sDecimalNo = ","
Else
sDecimal = ","
sDecimalNo = "."
End If
strNum = Trim$(strNum)
If Left$(strNum, 1) = sDecimalNo Then
Mid$(strNum, 1, 1) = sDecimal
End If
'Si el número introducido contiene signos no decimales
j = 0
i = 1
Do
i = InStr(i, strNum, sDecimalNo)
If i Then
j = j + 1
i = i + 1
End If
Loop While i
If j = 1 Then
'cambiar ese símbolo por un espacio, si sólo hay uno de esos signos
i = InStr(strNum, sDecimalNo)
If i Then
If InStr(strNum, sDecimal) Then
Mid$(strNum, i, 1) = " "
Else
Mid$(strNum, i, 1) = sDecimal
End If
End If
Else
'En caso de que tenga más de uno de estos símbolos
'convertirlos de manera adecuada.
'Por ejemplo:
'si el signo decimal es la coma:
' 1,250.45 sería 1.250,45 y quedaría en 1250,45
'si el signo decimal es el punto:
' 1.250,45 sería 1,250.45 y quedaría en 1250.45
'
'Aunque no se arreglará un número erróneo:
'si el signo decimal es la coma:
' 1,250,45 será lo mismo que 1,25
' 12,500.25 será lo mismo que 12,50
'si el signo decimal es el punto:
' 1.250.45 será lo mismo que 1.25
' 12.500,25 será lo mismo que 12.50
'
i = 1
Do
i = InStr(i, strNum, sDecimalNo)
If i Then
j = j - 1
If j = 0 Then
Mid$(strNum, i, 1) = sDecimal
Else
Mid$(strNum, i, 1) = " "
End If
i = i + 1
End If
Loop While i
End If
j = 0
'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
ConvDecimal = strNum
End Function
Hasta aquí hemos llegado, creo que no te
quejarás de código, pero si quieres, puedes bajartelo todo, incluido el del
programa de pruebam, en un solo fichero.
Pulsa este link para bajarte cCambio.zip (11.0 KB)
Nos vemos.
Guillermo
