Prueba de convertir una clase de versiones anteriores a VB.NET (cNum2Text)
Prueba de convertir una clase de versiones
anteriores a VB.NET (cNum2Text)
Actualizado: 25/Oct/2000
Por ahora sólo está el código de la clase, más adelante
pondré el código del formulario que usa esta clase y alguna captura de dicho
formulario.
Para convertir a vb.net, he hecho
lo siguiente:
Añado los Imports de Microsoft.VisualBasic.*
Convierto los As Long en As Integer
Pongo los Options al principio
Cambio las dimensiones "(0 To" por "("
Lo mismo con las que empiezan por 1
Pongo un comentario delante de cada Attribute...
Quito el Class_Initialize y pongo el código en el Sub New
Las variables declaradas como Static, la declaro a nivel de módulo
Corrijo adecuadamente el valor devuelto por Val(, ya que es un
Double
Cambio las variables Single a Double (sólo
había 1)
Pongo CInt( en los valores devueltos a
Integers
Convierto los LSet en la función LSetStr
Por ejemplo:
LSet sNumero = strNum ->
LSetStr(sNumero, strNum)
Convierto las llamadas a String$(n, Char) en una función:
vbString(n, Char)
Convierto los valores predeterminados de la Enumeración eSexo en
Constantes
Creo la función Abs
Quito la enumeración eSexo y lo asigno como Integer
'------------------------------------------------------------------------------
' cNumero2Letra clase para convertir números a letras (04/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)
'
' Corrección para cientos millones (05/Mar/99)
' Corrección para cientos millones (2ª) (30/Jun/00)
' Pluralizar es un función pública (07/Jul/00)
' Nuevos arreglos a los decimales, ver comentarios. (08/Jul/00)
' Arreglado el tema del sexo de los céntimos (20/Jul/00)
'
' Convertida para usar en VB.NET (20/Oct/00)
'
' ©Guillermo 'guille' Som, 1991-2000
'
' Para convertir a vb.net, he hecho lo siguiente:
' Añado los Imports de Microsoft.VisualBasic.*
' Convierto los As Long en As Integer
' Pongo los Options al principio
' Cambio las dimensiones "(0 To" por "("
' Lo mismo con las que empiezan por 1
' Pongo un comentario delante de cada Attribute...
' Quito el Class_Initialize y pongo el código en el Sub New
' Las variables declaradas como Static, la declaro a nivel de módulo
' Corrijo adecuadamente el valor devuelto por Val(, ya que es un Double
' Cambio las variables Single a Double (sólo había 1)
' Pongo CInt( en los valores devueltos a Integers
' Convierto los LSet en la función LSetStr
' Por ejemplo:
' LSet sNumero = strNum -> LSetStr(sNumero, strNum)
' Convierto las llamadas a String$(n, Char) en una función: vbString(n, Char)
' Convierto los valores predeterminados de la Enumeración eSexo en Constantes
' Creo la función Abs
' Quito la enumeración eSexo y lo asigno como Integer
'
' Para compilar como una DLL:
' vbc cNum2Text.vb /out:Guille.Num2Text.dll /t:library /r:system.winforms.dll
'------------------------------------------------------------------------------
Option Explicit
Option Compare Text
Imports System
' Para poder usar el MessageBox, además de los formularios
Imports System.WinForms
' Para compatibilidad con VB
Imports Microsoft.VisualBasic.Conversion
Imports Microsoft.VisualBasic.Strings
Imports Microsoft.VisualBasic.ControlChars
Imports Microsoft.VisualBasic.ErrObject
Namespace Guille.Num2Text
Public Class cNum2Text
'Declaradas a nivel de módulo
Dim unidad(10) As String
Dim decena(10) As String
Dim centena(11) As String
Dim deci(10) As String
Dim otros(16) As String
Private m_Sexo1 As String
Private m_Sexo2 As String
Private m_LenSexo1 As Integer
' Variables declaradas Static:
' En Numero2Letra
Private SexoAntMoneda As Integer 'eSexo
Private SexoAntCentimos As Integer 'eSexo
'
'Public Enum eSexo
' Femenino '= 0
' Masculino '= 1
'End Enum
Private Const _Femenino As Integer = 0
Private Const _Masculino As Integer = 1
' Constantes
Private Const vbCr As Char = CChar(13)
Private Const vbLf As Char = CChar(10)
Private Const vbCrLf As String = vbCr & vbLf
' Este es el cosntructor de la clase
Public Sub New()
MyBase.New
'
m_Sexo1 = "a"
m_Sexo2 = "as"
InicializarArrays
End Sub
' Este es el destructor de la clase
Public Sub Dispose()
'MyBase.Dispose
'components.Dispose
End Sub
Protected Function LSetStr(ByRef strDest As String, ByVal strNum As String) As String
' Asigna a strDest el contenido de strNum
' con espacios delante hasta completar la longitud total de strDest
Dim iDest As Integer
iDest = strDest.Length
strDest = Right$(Space$(iDest) & strNum, iDest)
' Devolver también el valor
Return strDest
End Function
Protected Function Abs(ByVal dblNum As Double) As Double
' Devuelve el valor absoluto
If dblNum < 0 Then
Return -dblNum
Else
Return dblNum
End if
End Function
' Función para sustituir a String$ del Visual Basic
Protected Function vbString(ByVal intNum As Integer, ByVal strChar As String) As String
' Devuelve intNum veces la cadena strChar
Dim i As Integer
Dim s As String
For i = 1 To intNum
s &= strChar
next
Return s
End Function
Public Function Numero2Letra( _
ByVal strNum As String, _
Optional ByVal Lo As Integer = 0 , _
Optional ByVal NumDecimales As Integer = 2, _
Optional ByVal sMoneda As String = "", _
Optional ByVal sCentimos As String = "", _
Optional ByVal SexoMoneda As Integer = _Femenino, _
Optional ByVal SexoCentimos As Integer = _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" <esteve@mur.hnet.es> (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 Integer
Dim iHayDecimal As Integer '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 fFraccion As Double
Dim sNumero As String
Dim sSexoCents As String
'
' Para tener en cuenta el sexo de los céntimos (20/Jul/00)
' m_Sexo2 se usa para indicar el plural de las monedas,
' sSexoCents sustituirá a esa variable cuando se calculen los céntimos
If SexoCentimos = _Femenino Then
sSexoCents = "as"
Else
sSexoCents = "os"
End If
'
'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) & vbString(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)
'
' NO hacer cálculos de redondeo ni nada de nada (08/Jul/00)
'
' De esta forma se dirá:
' ,06 con seis
' ,50 con cincuenta
'
sFraccion = Left$(sFraccion, NumDecimales)
'
'* En las fracciones los ceros a la derecha no tienen significado
'----------------------------------------------------------------------
' Pero si tenemos: 125.50 si que tiene significado, (08/Jul/00)
' ya que tal y como está ahora, diría con 5 en lugar de cincuenta
' Así que si se ponen NumDecimales mayor de 2,
' hay que ser consecuentes con los resultados.
'----------------------------------------------------------------------
'*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
'
Try
strNum = RTrim$(UnNumero(sEntero, m_Sexo1) & sMoneda)
Catch er As Exception
MessageBox.Show("en If fFraccion < 1 Then" & vbCrLf & er.toString)
End Try
'
If Lo Then
LSetStr(sNumero, strNum)
Else
sNumero = strNum
End If
Numero2Letra = sNumero
Exit Function
End If
If Len(Trim$(sMoneda)) Then
sMoneda = Pluralizar(sEntero, sMoneda)
End If
Try
sEntero = UnNumero(sEntero, m_Sexo1)
Catch er As Exception
MessageBox.Show("sEntero = UnNumero(sEntero, m_Sexo1)" & vbCrLf & er.toString)
Exit Function
End Try
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...
'
' Sustituimos el plural de las monedas, (20/Jul/00)
' para adecuarla a los céntimos,
' ya que en España, la moneda es femenino, pero los céntimos masculino.
m_Sexo2 = sSexoCents
If SexoCentimos = _Masculino Then
Try
sFraccion = UnNumero(sFraccion, "")
Catch er As Exception
MessageBox.Show("sFraccion = UnNumero(sFraccion, '')" & vbCrLf & er.toString)
End Try
Else
Try
sFraccion = UnNumero(sFraccion, "a")
Catch er As Exception
MessageBox.Show("sFraccion = UnNumero(sFraccion, 'a')" & vbCrLf & er.toString)
End Try
End If
'
strNum = sEntero & sMoneda & "con " & sFraccion & sCentimos
If Lo Then
LSetStr(sNumero, RTrim$(strNum))
Else
sNumero = RTrim$(strNum)
End If
Numero2Letra = sNumero
Else
If Len(Trim$(sMoneda)) Then
sMoneda = Pluralizar(strNum, sMoneda)
End If
Try
strNum = RTrim$(UnNumero(strNum, m_Sexo1) & sMoneda)
Catch er As Exception
MessageBox.Show("strNum = RTrim$(UnNumero(strNum, m_Sexo1) & sMoneda)" & vbCrLf & er.toString)
End Try
If Lo Then
LSetStr(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 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
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
m_LenSexo1 = Len(m_Sexo1)
'
' idea aportada por Harvey Triana
' para no tener que estar reinicializando continuamente los arrays
'
' Se ve que lo anterior fallaba si se usaba varias veces seguidas (05/Mar/99)
'
'Dim s As String
'Try
' s=unidad(1)
'Catch er As Exception
' MessageBox.Show("If unidad(1) <> 'un' & Sexo1 Then" & vbCrLf & er.toString)
'End Try
'
If unidad(1) <> "un" & Sexo1 Then
InicializarArrays
End If
'
' If m_Sexo1 <> Sexo1Ant Then
' unidad(2) = ""
' End If
' '
' If unidad(2) <> "dos" Then
' InicializarArrays
' End If
'
'Si se produce un error que se pare el mundo!!!
'On 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"
Return "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
'
' ¡OJO!, los arrays declarados con N elementos, van de 0 a N-1
ReDim strN(cGrupos + 1)
strQ = Right$(vbString(cAncho, "0") & strNum, cAncho)
For k = Len(strQ) To 1 Step -3
' Aunque el array esté dimensionado para usar valores de 0 a cGrupos,
' se usan sólo de 1 a cGrupos (como en el fichero original)
vez = vez + 1
Try
strN(vez) = Mid$(strQ, k - 2, 3)
Catch er As Exception
MessageBox.Show("strN(vez) = Mid$(strQ, k - 2, 3), vez= " & vez.ToString & vbCrLf & er.toString)
End try
Next
' Eliminar los grupos del principio que estén formados por ceros
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 = CInt(Val(Right$(strNum, 2)))
If Right$(strNum, 1) = "0" Then
k = k \ 10
strD = decena(k)
ElseIf k > 10 And k < 16 Then
k = CInt(Val(Mid$(strNum, L - 1, 2)))
strD = otros(k)
Else
strU = unidad(CInt(Val(Right$(strNum, 1))))
If L - 1 > 0 Then
k = CInt(Val(Mid$(strNum, L - 1, 1)))
strD = deci(k)
End If
End If
'---Parche de Esteve
If L - 2 > 0 Then
k = CInt(Val(Mid$(strNum, L - 2, 1)))
'Con esto funcionará bien el 100100, por ejemplo...
If k = 1 Then 'Parche
If CInt(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 = True Then
If Millones = True 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 dobles 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
'---Nueva comparación (01:16 25/Ene/99)
If Left$(strB, 5) = "un un" Then
strB = Mid$(strB, 4)
End If
'
' Comprobar sólo si se especifica "un* mil ", (05/Mar/99)
' no "un* mil" ya que puede ser "un* millón"
'If Left$(strB, 6 + m_LenSexo1) = "un" & m_Sexo1 & " mil" Then
If Left$(strB, 7 + m_LenSexo1) = "un" & m_Sexo1 & " mil " Then
strB = Mid$(strB, 4 + m_LenSexo1)
' Puede que el importe sea sólo "un mil" o "una mil" (19/Ago/00)
ElseIf strB = "un" & m_Sexo1 & " mil" Then
strB = Mid$(strB, 4 + m_LenSexo1)
End If
'
'---Nueva comparación (15:11 25/Ene/99)
'If Left$(strB, 6) = "un mil" Then
' Que debe estar así, para que no quite "un millón" (05/Mar/99)
If Left$(strB, 7) = "un mil " Then
strB = Mid$(strB, 4)
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
'---Nueva comparación (15:13 25/Ene/99)
If Right$(strB, 15) <> "millones mil un" Then
iA = InStr(strB, "millones mil un")
If iA Then strB = Left$(strB, iA + 8) + Mid$(strB, iA + 13)
End If
'
' De algo sirve que la gente pruebe las rutinas... (05/Mar/99)
' ¡¡¡ Gracias gente !!!
If Millones Then
' Comprobación de -as ??? millones
' convertir en -os ??? millones
' Pero sólo si el sexo es femenino
If m_Sexo1 = "a" Then
If (strB Like "*as * millones*") Then
' Buscar la primera terminación "as " y cambiar por "os "
k = InStr(strB, "as ")
If k Then
Mid$(strB, k) = "os "
End If
End If
' La comparación anterior no funciona con x00 millones (30/Jun/00)
If (strB Like "*as millones*") Then
' Buscar la primera terminación "as " y cambiar por "os "
k = InStr(strB, "as millones")
If k Then
Mid$(strB, k) = "os millones"
End If
End If
'
'
'------------------------------------------------------------------
' Comprobar si dice algo así ...una millones (08/Jul/00)
' Por ejemplo en 821.xxx.xxx decia ochocientos veintiuna millones
'------------------------------------------------------------------
k = InStr(strB, "una mill")
If k Then
strB = Left$(strB, k + 1) & Mid$(strB, k + 3)
End If
'
'
End If
End If
'
'
'--------------------------------------------------------------------------
' Cambiar los veintiun por veintiún, etc por sus acentuadas (08/Jul/00)
Do
k = InStr(strB, "veintiun ")
If k Then
Mid$(strB, k) = "veintiún "
End If
Loop While k
' El veintidos creo que nunca lo he acentuado... (08/Jul/00)
' pero en la enciclopedia consultada lo acentúa
Do
k = InStr(strB, "veintidos ")
If k Then
Mid$(strB, k) = "veintidós "
End If
Loop While k
Do
k = InStr(strB, "veintitres ")
If k Then
Mid$(strB, k) = "veintitrés "
End If
Loop While k
Do
k = InStr(strB, "veintiseis ")
If k Then
Mid$(strB, k) = "veintiséis "
End If
Loop While k
'--------------------------------------------------------------------------
'
'
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)
Return Trim$(strB)
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
Public Function Pluralizar( _
ByVal sNumero As String, _
ByVal sMoneda As String, _
Optional ByVal bCadaPalabra As Boolean = False) As String
'--------------------------------------------------------------------------
' Pluraliza la moneda, si el valor de número es distinto de uno
'
' Ahora es una función pública (07/Jul/00)
'
' Parámetros:
' sNumero Importe, para saber si hay que pluralizar o no
' sMoneda Cadena con la palabra a pluralizar
' bCadaPalabra Si se pluralizan todas las palabras (08/Jul/00)
'--------------------------------------------------------------------------
Dim dblTotal As Double
Dim sTmp As String
Dim i As Integer
If Len(Trim$(sMoneda)) Then
' He quitado el Val (08/Jul/00)
'dblTotal = Val(sNumero)
'
' Si entra una cadena vacia, da error (08/Jul/00)
If Len(sNumero) = 0 Then
sNumero = "0"
End If
'dblTotal = (sNumero)
' Vuelvo a ponerlo para VB.NET (21/Oct/00)
dblTotal = Val(sNumero)
'
If dblTotal <> 1# Then
sMoneda = Trim$(sMoneda)
' Si se pluralizan todas las palabras (08/Jul/00)
If bCadaPalabra Then
sMoneda = sMoneda & " "
sTmp = ""
For i = 1 To Len(sMoneda)
If Mid$(sMoneda, i, 1) = " " Then
' pluralizar
If InStr("aeiou", Right$(sTmp, 1)) Then
sTmp = sTmp & "s"
Else
sTmp = sTmp & "es"
End If
End If
sTmp = sTmp & Mid$(sMoneda, i, 1)
Next
sMoneda = " " & Trim$(sTmp) & " "
Else
If InStr("aeiou", Right$(sMoneda, 1)) Then
sMoneda = " " & sMoneda & "s "
Else
sMoneda = " " & sMoneda & "es "
End If
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
'*Attribute ConvDecimal.VB_Description = "Si la cadena contiene decimales, convertirlo al adecuado para usar con Val"
'*Attribute ConvDecimal.VB_HelpID = 21080
' 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 Integer
Dim j As Integer
On Error Resume Next ' Si se produce un error, continuar (07/Jul/00)
' 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
'Err.Number = 0
End Function
End Class
End Namespace
...
Nos vemos.
Guillermo
