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.clsNota: 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 SubcMonedas: 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 FunctioncCambio: 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 FunctionBien, 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 SubEspero 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á.
ConvDecimal es un método/función de "chequeo" de decimales, para que maneje de forma correcta tanto los números con comas como con puntos. El valor del signo decimal, lo toma según la configuración regional, pero en las pruebas que he hecho, si se cambia el signo en el panel de control, la función Format$ no se aclara y por tanto hace que falle esa función.
En el código de ese método están los ejemplos de las cosas que puede manejar y las que no.
Si te parece una chorrada, lo he hecho para que al introducir decimales reconozca tanto la coma como el punto, siempre y cuando no se especifiquen separadores de miles.
Por ejemplo:
Esto funcionaría bien: 1.250,25 y 1250,25 y también 1250.25 pero no: 1,250.25
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 FunctionHasta 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