Option Explicit
' Modificado: Funcion_Número_Letras_Mas_Moneda-Modulo1. 2015/10/30 07:20 p.m.
'
' La fuente original no lo sé con seguridad, pero en el foro de
' emagister Excel un amigo lo publicó hace muchos años (Armando Montes).
' Descargado de www.excelnegocios.com
' Gustavo A. Sebastiani: Solo he realizado unas minúsculas modificaciones,
' por tanto no me declaro en ningún momento autor de la fórmula.'
' Adiciones al Procedimiento por Miguel Ángel Mendoza G. Octubre 2015,
' indicadas en REFERENCIA Y EJEMPLOS ...
'
' Forma de utilizar la Función: NumeLetras
' ARGUMENTOS:
' Requiere 4 Parámetros obligatorios:
' 1.- Primer parámetro: "numero", el valor a convertir a "Texto" con
' los parámetros "conector" y/o "moneda"
' La función se ha ajustado para Admitir 78 Dígitos significativos
' de la parte entera más 2 dígitos para la parte fraccionaria si
' el valor en moneda y 15 si es número es tratado con fracciones.
' 2.- Segundo Parámetro: "conector", tiene dos funciones la Primera:
' 2.A) El "conector" se incluye entre la Conversión de la parte
' entera y la parte Fraccionaria, Excepto para los valores
' definidos en el Estilo.
' 2.B) El La segunda función es la de Incluir "Comandos" para agregar
' palabras reservadas con determinada sintaxis y estos "Comandos"
' hagan cambiar algunas opciones en los datos de entrada y/o
' ampliar, modificar las características de la forma y salida
' de la conversión de "números" a "letras".
' La forma que se incluir comandos es agregar la expresión:
' %com% después del "conector" a utilizar.
' Comandos Definidos:
' 2.B.1) "monitor"
' Con este comando agrega datos que utiliza en la conversión
' y permite monitorear ciertos valores de las variables, es
' para cuando se hacen ajustes al "código".
' 2.B.2) "coma"
' Permite cambiar el carácter por omisión por otro definido
' después del comando, no acepta el "Espacio".
' Ejemplo: conector = "Pesos%com%coma."
' 2.B.3) "punto"
' 2.B.4) "invcoma"
' 2.B.5) "invpunto"
' 2.B.6) "separa"
' 3.- Tercer Parametro:
' La "moneda" se agrega al final de la conversión, Excepto en los
' valores definidos en el "Estilo".
' 4.- Parámetro "Estilo"
' Dependiendo del valor define la forma en hacer la conversión,
' el "Estilo" está formado por la parte Entera que define en
' principio los valores de dar formato a los caracteres de salida.
' 4.A) Según los Valores para Estilo se aplica para la conversión al
' Texto:
' 0 = sin aplicar cambios
' 1 = MAYUSCULAS
' 2 = minúsculas
' 3 = Tipo Titulo
' 4 = Tipo Oración: Primera palabra en mayúsculas.
' 4.B) El rango de valor del estilo en múltiplos de diez da la opción
' de seleccionar el IDIOMA (A estos valor sumar los valres de la
' Opción 4.A, para la conversión al Texto).
' IDIOMA Condición para el rango del valor del Parámetro "Estilo":
' 0- Español Estilo > -10 y Estilo < 10
' 1- English Estilo >=10 y Estilo < 20 o Estilo > -20 y Estilo <= -10
' 2- Français Estilo >=20 y Estilo < 30 o Estilo > -30 y Estilo <= -20
' 3- Italiano Estilo >=30 y Estilo < 40 o Estilo > -30 y Estilo <= -30
' 4- Portugués Estilo >=40 y Estilo < 50 o Estilo > -40 y Estilo <= -50
'
' 4.C) La parte fraccionaria da opcionnes adicionales al FORMATO de
' Conversión, se adicionan ejemplos en la siguiente sección
' incisos de la "i" a "n".
'
' REFERENCIA Y EJEMPLOS DE LOS AJUSTES ADICIONALES.
' a) Opción de Primera letra en mayúsculas: Estilo igual a 4.
' b) Cambiar el Parámetro "numero" de "Double" pasarlo a "Variant" para
' admitir conversiones a más dígitos significativos.
' En este cambio maneja la conversión tratada como número o cadena
' de caracteres, incluye números con formato Cientifico o Exponencial.
' Ampliar la conversión del formato en lugar de 15 Dígitos a 78
' Dígitos para el idioma Español y 30 para los otros Idiomas
' (Falta completar los textos correspondientes en los otros idiomas).
' c) Adicionar la conversión a los idiomas: Inglés, Francés, Italiano y
' Portugués
' d) La Opción de Estilo a Valores del 1 a 4 tomar los de 6 a 9 para
' convertir la parte fraccionaria a Texto inclusive agregando la
' leyenda de "centavo(s)", continuando con los estilos del 1 al 4.
' e) Cambiar la Leyenda "uno " en Lugar de "un " para los casos que
' no incluye la leyenda "moneda" o incluye conversión de fracción
' a texto (Estilo1=4 y/o Estilo < 0).
' f) Corregir el caso de 0.00 para agregar el texto de: "Cero"
' Corrige el caso de "dieciséis " en lugar de "dieciseis "
' Corrige el caso de "veintidós " en lugar de "veintidos "
' Corrige el caso de "veintitrés " en lugar de "veintitres "
' Corrige el caso de "veintiséis " en lugar de "veintiseis "
' Corrige el caso de "mil " en lugar de "un mil ", expepto para
' los casos con Estilo más .5 o .6 (Estilo1 = 5 ó m 6).
' Agregar la leyenda "de" en casos como: "Un mill?n pesos 00/100"
' cambie a: "Un millón de Pesos 00/100 MN"
' g) la Opción de "Estilo" con valores Negativos, para solo hacer la
' conversión del valor sin incluir los parámetros de Conector ni
' Moneda, en este caso para las opciones de Estilo: -6,-7,-8,-9
' agrega la leyenda correspondiente a el valor de la fracción,
' En este caso es similar a agregar 4 décimas al valor del Estilo.
' h) Agregar una décima en el Parámetro "Estilo" para que sea manejado
' con un dígito adicional para Incluir otras Opciones, dicho valor
' define a "Estilo1" para referencia de las "Opciones" implementadas.
' i) Incluir a "Estilo" una décima (.1, Estilo1 = 1) para realizar la
' conversión en la que INLUYA el parámetro "Conector", bajo el
' criterio de "CALIFICACIONES".
' Realiza la conversión definida por los siguientes criterios:
' 1.- Convierta a Texto la parte Entera
' 2.- Agrega el Parámetro "Conector"
' 3.- Agregue la Conversión a Texto de la parte fraccionaria, en
' el caso de la fracción sea menor a un Decimo, agregue "cero"
' y la Conversión del dígito de las Centésimas a Texto.
' 4.- No Incluya el parámetro de "Moneda". Ejemplos:
' NumeLetras(9.63,"punto","",3.1) = Nueve Punto Sesenta Y Tres
' NumeLetras(8.07,"coma","",4.1) = Ocho coma cero siete
' j) Incluir a "Estilo dos décima (.2, Estilo1 = 2) para realizar la
' conversión en la que NO INLUYA el parámetro "Conector" ni la
' Parte Fraccionaria, y Si incluya el parámetro "Moneda", es para
' ocasiones o lugares que no manejen o no den importancia a la
' parte fraccionaria.
' k) Incluir a "Estilo" tres décima (.3, Estilo1 = 3) para realizar la
' conversión de números tipo "TELEFONO" (si son dígitos o números
' Enteros) separando cada cifra por un carácter diferente a los
' dígitos o los caracteres definido como "Punto" Decimal y "coma"
' como separador de dígitos,
' Ejemplo: A2 ="01 222 78 70" ;
' B2 =NumeLetras(A2,"","",2.3) ; dará como resultado:
' B2 ="cero uno - doscientos veintidós - setenta y ocho - setenta"
' A2 ="01 222 78 71" ; B2 =NumeLetras(A2,"","",34.3)
' Dará como resultado:
' B2 = "Zéro uno - duecento ventidue - settantotto - settantuno"
' Si se dan números fraccionarios realiza la conversión en texto del
' número agregando el texto de "punto" como separador de la parte entera
' y si hay ceros después del punto agrega la leyenda "cero" hasta
' encontrar un valor mayor a cero, Ejemplo para el texto con celda:
' A2 = "11 17.00542 5";
' Celda B2 con la función : =NumeLetras(A2,"","",2.3)
' Dara el resultado:
' "once - diecisiete punto cero cero quinientos cuarenta y dos - cinco"
' En Esta conversión incluye agregar el texto entre los números a
' convertir, Ejemplo:
' A2 ="El número es: (Lada 01 2 45) 34 2 04 67 los lunes de las 2 a
' las 3 de la tarde sin falta"
' B2 =NumeLetras(A2,"","",4.3)
' Dará la siguiente conversión:
' B2 ="El número es: (Lada cero uno - dos - cuarenta y cinco )
' treinta y cuatro - dos - cero cuatro - sesenta y siete los lunes de las
' dos a las tres de la tarde sin falta"
'
' l) Incluir a "Estilo" cuatro décima (.4, Estilo1 = 4) para realizar la
' conversión con la leyenda de la parte fraccionara correspondiente a su
' valor.
' Ejemplo para el valor: 16.0872
' A2 = NumeLetras(16.00872,"","",3.1) ; dará como conversión:
' A2 = Dieciséis con ochocientos setenta y dos dieznmilésimos
' m) Incluir a "Estilo" Cinco decimas (.5), Estilo1 = 5) y 6 decimas.
' Formato con las Siguientes características:
' 1.- Incluir el "Conector" al Principio.
' (Ejemplo: "$") y un Espacio (" ").
' 2.- Luego poner la cantidad en valor numérico (Ejemplo: "1520.75").
' 3.- Agregar Abrir Paréntesis " (".
' 4.- Agregar el Parámetro "Moneda".
' 5.- Agregar el Parámetro "numero" convertido a Texto,
' 5.- Agregar el texto: " con ".
' 7.- Agregar la parte decimal con 2 dígitos.
' 8.- Agregar el Texto final: "/00)".
' Ejemplo: =NumeLetras(1520.75,"$","Pesos",3.5), De el siguiente
' resultado:
' $ 1520.75 (Pesos Un mil quinientos veinte con 75/100)
' Cambiando a "Tipo" a valores 1.5; Dará: TEXTO EN MAYUSCULAS
' $ 1520.75 (PESOS UN MIL QUINIENTOS VEINTE CON 75/100)
' Cambiando a "Tipo" a valores 8.6; Hará una separación de miles:
' $ 1,520.75 (Pesos Un mil quinientos veinte con centavos)
' n) Incluir a "Estilo" Seis decimas (.6) para formar un resultado:
' 1.- Similar a el caso anterior de Estilo1 = 5, con el siguiente cambio:
' 2.- Agregar los dígitos del valor numérico, con separación de coma ","
' cada tres Dígitos Enteros.
' 3 a 8 Similar a Estilo1 = 5. Ejemplo, con Estilo = 8.6
' $ 1,520.75 (Pesos Un mil quinientos veinte con setenta y cinco centavos)
'
' Estilo = Formato de salida Valores: 1,2,3,4,6,7,8,9 Implica agregar los
' Textos de: "Conector" y "Moneda", Exceptuando cuando se agrega una décima al valor.
' Para Estilo >= 6 y <= 9 implica poner la parte de la fracci?n en Texto
' y Estilo toma el Valor de: Estilo - 5
' Si el valor es Negativo: (-1,-2,-3,-4,-6,-7,-8,-9) implica:
' No incluye en el Texto la Leyenda de Conector y Moneda
' y Estilo Se convierte a valor Positivo, para continuar las Opciones.
' 6-9 = Agrega la parte fraccionaria en Texto, y a Estilo se le resta 5
'
' Estilo = Formato de salida Valores: 1,2,3,4,6,7,8,9 Implica agregar los
' Textos de: "Conector" y "Moneda", Exceptuando cuando se agrega una décima al valor.
' Para Estilo >= 6 y <= 9 implica poner la parte de la fracci?n en Texto
' y Estilo toma el Valor de: Estilo - 5
' Si el valor es Negativo: (-1,-2,-3,-4,-6,-7,-8,-9) implica:
' No incluye en el Texto la Leyenda de Conector y Moneda
' y Estilo Se convierte a valor Positivo, para continuar las Opciones.
' 6-9 = Agrega la parte fraccionaria en Texto, y a Estilo se le resta 5
'
' Los valores negativos los convierte a positivos
'
Public TFNumero As String
Public Idioma As Byte
Public Function NumeLetras(ByVal numero As Variant, _
conector As String, _
moneda As String, _
ByVal EstiloEnt As Double) As String
' MsgBox " numero =[" & numero & "], conector=[" & conector _
' & "], moneda=[" & "], Estilo=" & Format(EstiloEnt, "00.00")
Dim NumTmp, sTem, s1 As String
Dim c01, c02, num1, pos, pos1, pos2, dig, cen, dec, uni, m, n As Integer
Dim Estilo, Estilo1 As Byte
Dim letra1, letra2, letra3 As String
Dim Leyenda, param As String
Dim MonedaSiNo, MonedaSN As Boolean
Dim ConCentavos, ConCentimos, cae, uno As Boolean
Dim salida, Upper_Lower As Label
Static fracc(0 To 15, 0 To 4) As String
Static conAnd
conAnd = Array("con", "and", "et", "con", "com", _
"No es Número, ", "I is not number ", "Est pas un nombre ", _
"Io non è il numero ", "Eu não é o número ", _
"centavo", "cent", "cent", "cent", "centavo", _
"centésimo", "hundredth", "centième", "centesimo", "centésimo", _
"cero ", "zero ", "zéro ", "zéro ", "zéro ", _
"punto ", "point ", "point ", "point ", "point ")
fracc(0, 0) = "décimo"
fracc(1, 0) = "centésimo"
fracc(2, 0) = "milésimo"
fracc(3, 0) = "diezmilésimo"
fracc(4, 0) = "cienmilésimo"
fracc(5, 0) = "milloésimo"
fracc(6, 0) = "diezmilloésimo"
fracc(7, 0) = "cienmilloésimo"
fracc(8, 0) = "milmilloésimo"
fracc(9, 0) = "diezmilmilloésimo"
fracc(10, 0) = "cienmilmilloésimo"
fracc(11, 0) = "billónesimo"
fracc(12, 0) = "diezbillónesimo"
fracc(13, 0) = "cienbillónesimo"
fracc(14, 0) = "milbillónesimo"
fracc(15, 0) = "err num muy pequeño"
param = ",.-00" ' Valores por Omisión coma=","; punto="."; Separa=" 0"; No Monitor="0"
pos1 = 0 ' 4bsf:019405e237
sTem = Format(EstiloEnt, "00.0")
Estilo = Abs(Fix(EstiloEnt))
If Estilo > -10 And Estilo < 10 Then
Idioma = 0
ElseIf Estilo >= 10 And Estilo < 20 Then
Idioma = 1
Estilo = Estilo - 10
ElseIf Estilo >= 20 And Estilo < 30 Then
Idioma = 2
Estilo = Estilo - 20
ElseIf Estilo >= 30 And Estilo < 40 Then
Idioma = 3
Estilo = Estilo - 30
ElseIf Estilo >= 40 And Estilo < 50 Then
Idioma = 4
Estilo = Estilo - 40
Else
Idioma = 0 ' Por Omisión Idioma Español
If Estilo >= 40 Then
Estilo = Estilo Mod 10
End If
End If
If numero = "" Then numero = 0
MonedaSN = IsNumeric(numero)
Estilo1 = Val(Mid(sTem, 4, 1))
If Estilo1 = 3 Then ' tipo entrada n{umeros separados
param = Left(param, 3) & "1" & Right(param, 1)
MonedaSN = False
End If
TFNumero = ""
conector = Trim(conector)
param = comando(conector, param) ' Parametros actualizados por comando
If Left(numero, 1) = " " Or Right(numero, 1) = " " Then numero = Trim(numero)
If Left(numero, 1) = "0" And Mid(param, 4, 1) = "0" Then
pos = 1 ' Elimina ceros a la Izquierda
Do While Mid(numero, pos, 1) = "0" And pos < Len(numero)
pos = pos + 1
Loop
pos = pos - 1
If Len(numero) > pos Then
numero = Right(numero, Len(numero) - pos)
End If
End If
If MonedaSN = False And Mid(param, 4, 1) = "0" Then
TFNumero = TFNumero & conAnd(Idioma + 5) ' "!No es Número "
ElseIf Mid(param, 4, 1) = "1" Then
MonedaSN = False
ElseIf numero < 0 Then
numero = Abs(numero)
End If
If EstiloEnt < 0 Then ' Determina si el Estilo es Negativo:
MonedaSiNo = False ' implica no poner el "conector", ni "moneda"
ConCentimos = True ' para definir valor parte fraccionaría
Estilo1 = 4 ' Parte Fraccionaria conertida en texto completo
Else ' Implica poner el "conector" y "moneda"
MonedaSiNo = True
If Estilo >= 6 And Estilo <= 10 Then
ConCentavos = True ' Implica convertir fracción en Texto
ConCentimos = True
Else
ConCentimos = False
End If
End If
If Estilo >= 6 And Estilo <= 10 Then
Estilo = Estilo - 5 ' Tipo Conversi+on carácteres de salida
End If
If Estilo1 = 1 Then ' No incluye Fracción de moneda
ConCentimos = True ' Incluye fracción en Texto
MonedaSiNo = False
ElseIf Estilo1 = 2 And EstiloEnt > 0 Then
MonedaSiNo = True ' Incluye Fracción de moneda
ConCentimos = False ' No incluye Fracción
End If
param = param & Format(Idioma, "00") ' 6-07
param = param & Format(Estilo, "00") ' 8-09
param = param & Format(Estilo1, "00") ' 10-11
For pos = 1 To 12
param = param & "0"
Next pos
c01 = Len(numero)
c02 = Fix((c01 + 5) / 6)
MonedaSN = IIf(Estilo1 = 5 Or Estilo1 = 1, False, MonedaSiNo)
If Estilo1 = 4 And Idioma = 0 Then
uno = True
ElseIf MonedaSN = False And Idioma = 0 Then
uno = True
Else
If Idioma = 0 Then
uno = IIf(conector = "", True, False)
End If
End If
If c01 > 0 Or MonedaSN = False Then ' Longitud entrada
sTem = CStr(numero)
If Mid(param, 4, 1) = "1" Then
sTem = sTem & " "
c01 = c01 + 1
Else
s1 = "E+" ' Num. notación Exponencial
pos = InStr(1, sTem, s1, 1) ' CompareMethod.Text
If pos = 0 Then
s1 = "E-"
pos = InStr(1, sTem, s1, 1)
If pos <> 0 Then
uni = Val(Left(sTem, pos - 1))
dec = Val(Right(sTem, Len(sTem) - pos - 1))
sTem = NExpTex(sTem, pos, False) ' Exp negatico
c01 = Len(sTem)
End If
Else
uni = Val(Left(sTem, pos - 1))
dec = Val(Right(sTem, Len(sTem) - pos - 1))
sTem = NExpTex(sTem, pos, True) ' Exp positivo
c01 = Len(sTem)
End If
End If
NumTmp = ""
cen = 0 ' Encuentra Punto decimal en la entrada
uni = 0 ' Número dígitos parte entera
dec = 0 ' Número dígitos parte fraccionaria
dig = 0 ' control carácter separador
pos2 = 0 ' Valor Dígitos, identificar valor cero entrada
n = 0 ' Conteo de separador Entero "."; admite 1 como válido
letra2 = ""
letra3 = ""
cae = True ' Admite primer Espacio " "
For pos2 = 1 To c01
letra1 = Mid(sTem, pos2, 1)
If letra1 < Chr(48) Or letra1 > Chr(57) Then
If letra1 = Chr(46) Then ' "." Punto
n = n + 1
If n = 1 Then '
uni = Len(letra2)
param = Left(param, 11) & Format(uni, "000") & _
Format(dec, "000")
param = param & Format(num1, "000") & "000"
If Mid(param, 4, 1) = "1" Then
If dig > 0 Or Len(letra3) > 0 Then
If Len(letra3) > 0 And letra3 <> " " Then
m = 0
If Len(TFNumero) > 0 Then
If Right(TFNumero, 1) <> " " Then m = 1
End If
If Len(letra3) > 0 And m = 0 Then
If Right(letra3, 1) <> " " Then letra3 = letra3 & " "
End If
TFNumero = TFNumero & letra3
letra3 = ""
dig = 0
Else
If Len(TFNumero) > 0 Then
If Right(TFNumero, 1) <> " " Then TFNumero = TFNumero & " "
End If
TFNumero = TFNumero & Mid(param, 3, 1) & " "
End If
End If
Leyenda = NumLet(param, letra2, numero, True, conAnd)
If dig > 0 And letra1 <> Chr(46) Then
TFNumero = TFNumero & Mid(param, 3, 1) & " "
dig = 0
End If
TFNumero = TFNumero & Leyenda
dig = 1
If cen = 0 Then
TFNumero = TFNumero & conAnd(25 + Idioma)
dig = 0
End If
Else
NumTmp = letra2 ' Parte Entera del número
End If
cen = 1 ' Fijo el Punto Decimal
letra2 = ""
Else ' más de un punto
letra3 = letra3 & " Punto+" & pos2 & "[" & letra1 & "] "
pos2 = c01 ' Termina revición
End If
Else
If letra1 <> Chr(44) Then ' No es separador coma ","
If Mid(param, 4, 1) = "1" Then
If cen = 1 Then
uni = Len(NumTmp)
Else
uni = Len(letra2)
NumTmp = letra2
End If
If cen = 1 And Len(letra2) > 0 Then
dec = Len(letra2)
NumTmp = NumTmp & "." & letra2
Else
dec = 0
End If
If Len(NumTmp) > 0 Then
param = Left(param, 11) & Format(uni, "000") & _
Format(dec, "000")
param = param & Format(num1, "000") & "000"
m = 0
If Len(TFNumero) > 0 Then
If Right(TFNumero, 1) <> " " Then m = 1
End If
If Len(letra3) > 0 And letra3 <> " " And m = 0 Then
If Len(letra3) > 0 Then
If Right(letra3, 1) <> " " Then letra3 = letra3 & " "
End If
TFNumero = TFNumero & letra3 ' & ".446."
letra3 = ""
dig = 0
End If
Leyenda = NumLet(param, NumTmp, numero, True, conAnd)
If dig > 0 Or Len(letra3) > 0 Then
m = pos2 + 1
If m < c01 Then
If Mid(sTem, m, 1) > Chr(47) And Mid(sTem, m, 1) < Chr(58) Then
If Len(letra3) > 0 And letra3 <> " " Then
If Len(letra3) > 0 Then
If Right(letra3, 1) <> " " Then letra3 = letra3 & " "
Else
TFNumero = TFNumero & " " & Mid(param, 3, 1) & " "
End If
TFNumero = TFNumero & letra3
letra3 = ""
dig = 0
End If
Else
If Len(letra3) > 0 Then
If Right(letra3, 1) <> " " Then letra3 = letra3 & " "
ElseIf dig > 0 Then
If Len(TFNumero) > 0 Then
If Right(TFNumero, 1) <> " " Then TFNumero = TFNumero & " "
End If
TFNumero = TFNumero & Mid(param, 3, 1) & " " '.476."
End If
letra3 = ""
dig = 0
End If
End If
End If
If letra3 <> " " And Len(letra3) > 0 Then
If Right(letra3, 1) <> " " Then letra3 = letra3 & " "
TFNumero = TFNumero & letra3 ' & ".478."
letra3 = ""
ElseIf dig > 0 Then
If Len(TFNumero) > 0 Then
If Right(TFNumero, 1) <> " " Then TFNumero = TFNumero & " "
End If
TFNumero = TFNumero & Mid(param, 3, 1) & " "
End If
TFNumero = TFNumero & Leyenda
End If
If dec > 0 Then
param = Left(param, 11) & Format(dec, "000") & _
Format(0, "000")
param = param & Format(num1, "000") & "000"
Leyenda = NumLet(param, letra2, numero, True, conAnd)
TFNumero = TFNumero & Leyenda
cen = dec - 1
If cen > 15 Then cen = 15
End If
If Len(letra3) = 0 And letra1 = " " Then
dig = IIf(letra1 = " ", 1, 0)
Else
dig = 1
End If
letra2 = ""
NumTmp = ""
cen = 0
n = 0
Else
letra3 = letra3 & pos2 & "[" & letra1 & "], " ' (1)
pos2 = c01 ' (2)
End If
Else ' Agrega dígito 0-9
letra2 = letra2 & letra1
End If
End If
If letra1 = " " And Len(TFNumero) > 0 Then
cae = IIf(Right(TFNumero, 1) = " ", False, True)
If Len(TFNumero) > 0 Then
If Right(TFNumero, 1) <> " " Then cae = False
End If
If Len(letra3) > 0 Then
If Right(letra3, 1) <> " " Then cae = True
End If
If cae Then
letra3 = letra3 & letra1 ' & ".522."
End If
ElseIf Mid(param, 4, 1) = "1" And letra1 <> Chr(46) Then
letra3 = letra3 & letra1
dig = 0
End If
If Len(TFNumero) > 0 Then
cae = IIf(Right(TFNumero, 1) = " ", False, True)
End If
Else ' es caracter númerico
If letra1 = "0" And Len(letra2) = 0 And Mid(param, 4, 1) = "1" Then
If dig > 0 Or Len(letra3) > 0 Then
If Len(letra3) > 0 And letra3 <> " " Then
TFNumero = TFNumero & letra3 ' .542."
letra3 = ""
Else
TFNumero = TFNumero & " " & Mid(param, 3, 1) & " "
End If
End If
TFNumero = TFNumero & conAnd(Idioma + 20) ' "cero "
dig = 0
Else
letra2 = letra2 & letra1
If Mid(param, 4, 1) = "0" And cen = 0 Then
num1 = num1 + Val(letra1) ' Verifica Valor número > 0
End If
End If
End If
Next pos2
If Mid(param, 4, 1) = "0" Then
If Len(letra3) > 0 Then ' Entrada no válida
If dec > 0 Then
TFNumero = TFNumero & " " & Mid(param, 3, 1) & " " '.564. "
End If
TFNumero = TFNumero & "[" & numero & "] " & letra3
n = 2
End If
If cen = 0 Then
uni = Len(letra2)
NumTmp = letra2
If Estilo1 = 4 Then
dec = 0
Else
dec = 2
NumTmp = NumTmp & ".00"
End If
Else
If Estilo1 <> 4 Then
If Len(letra2) = 0 Then
letra2 = "00"
ElseIf Len(letra2) = 1 Then
letra2 = letra2 & "0"
End If
End If
dec = Len(letra2)
If Len(letra2) > 0 Then NumTmp = NumTmp & "." & letra2
End If
Else
If Len(letra3) > 0 Then ' Si Existe texto lo
TFNumero = TFNumero & letra3 ' & ".513." ' Agrega al final
End If
n = 2 ' Termina converción
End If
End If
c02 = Fix((uni + 5) / 6)
dig = c02 - 1 ' param num1 12-14, dec: 15-17,
param = Left(param, 11) & Format(uni, "000") & Format(dec, "000") & _
Format(num1, "000")
If n > 1 Then
If Mid(param, 4, 1) = "1" Then
GoTo Upper_Lower
' Else
' GoTo salida ' Termina, No es entrada válida
End If
End If
If Estilo1 = 5 Or Estilo1 = 6 Then
' Adiciona "conector" y número en dígitos al principio
TFNumero = TFNumero & conector & " "
If Estilo1 = 5 Then ' Sin Separador de Miles
TFNumero = TFNumero & NumTmp
Else ' Format Con Separador de Miles
n = uni Mod 3 ' digitos Agregar al inicio antes de 1ra coma
If n > 0 Then
TFNumero = TFNumero & Left(NumTmp, n)
cen = 1
Else
cen = 0
End If
If uni > n Then
c01 = n + 1
For pos = c01 To uni Step 3
If cen > 0 Then ' Agrega "coma"
TFNumero = TFNumero & Mid(param, 1, 1)
Else
cen = 1
End If
TFNumero = TFNumero & Mid(NumTmp, pos, 3)
Next pos
End If
If dec > 0 Then
TFNumero = TFNumero & Mid(param, 2, 1) ' "punto"
End If
TFNumero = TFNumero & Right(NumTmp, dec) ' decimales
Estilo1 = 5
param = Left(param, 9) & Format(Estilo1, "00") & Mid(param, 12, 12)
End If
TFNumero = TFNumero & " (" & moneda & " "
pos1 = Len(TFNumero) ' Longitud parte inicial
Else
pos1 = 0
End If
param = param & Format(pos1, "000") ' 21-23
sTem = NumLet(param, NumTmp, numero, uno, conAnd)
TFNumero = TFNumero & sTem
If Estilo1 = 4 Then
If dec > 0 And Val(letra2) > 0 Then
param = Left(param, 11) & Format(dec, "000") & _
Format(0, "000")
param = param & Format(num1, "000") & "000"
Leyenda = NumLet(param, letra2, numero, False, conAnd)
TFNumero = TFNumero & conAnd(Idioma) & " " & Leyenda
cen = dec - 1
If cen > 15 Then cen = 15
TFNumero = TFNumero & fracc(cen, 0)
m = Len(TFNumero) - 1 - dec
If Val(Right(NumTmp, dec)) > 1 And cen < 15 Then
TFNumero = TFNumero & "s"
End If
TFNumero = TFNumero & " "
End If
GoTo Upper_Lower:
End If
If MonedaSN And Estilo1 < 2 Then
TFNumero = TFNumero & conector
ElseIf numero < 1 Then
If MonedaSiNo Or EstiloEnt < 0 Then
TFNumero = ""
End If
End If
m = Len(NumTmp) + 1 - dec
If ConCentimos Then
' MsgBox " ConCentimos=" & ConCentimos & ",m=" & m & ", Val=" & Val(Mid(NumTmp, m, 2))
If Val(Mid(NumTmp, m, 2)) > 0 Or ConCentavos Then
dec = Val(Mid(NumTmp, m, 1))
n = m + 1
uni = Val(Mid(NumTmp, n, 1))
If Estilo1 = 1 Then
Leyenda = ""
ElseIf ConCentavos Then
Leyenda = " " & conAnd(Idioma + 10) ' "centavo"
End If
letra2 = IIf(Estilo1 = 1 And dec = 0 And uni > 0, _
conAnd(Idioma + 20), Decena(uni, dec))
letra1 = IIf(dec + uni = 0, conAnd(Idioma + 20), Unidad(uni, dec))
If Estilo1 = 1 Then
TFNumero = TFNumero & " " & conector & " "
ElseIf numero >= 1 Or MonedaSiNo Then
TFNumero = TFNumero + " " & conAnd(Idioma) & " " ' " con "
End If
If Estilo1 = 1 And uni = 1 Then ' Corrige "uno " en lugar de "un "
letra1 = Left(letra1, Len(letra1) - 1) & "o "
End If
TFNumero = TFNumero + letra2 + letra1
If Idioma = 3 Then TFNumero = TFNumero & " "
TFNumero = TFNumero & Leyenda
' Corrige el caso de: centésimos en lugar de centésimo
If Val(Mid(NumTmp, 32, 2)) <> 1 And Estilo1 <> 1 Then
TFNumero = TFNumero + "s"
End If
TFNumero = TFNumero + " "
End If
End If
If MonedaSiNo Then
If ConCentavos Then
Else
If Estilo1 = 5 Or Estilo1 = 0 Then
TFNumero = TFNumero & " " & conAnd(Idioma)
End If
If Estilo1 <> 1 And Estilo1 <> 2 Then
TFNumero = TFNumero & " " & Mid(NumTmp, m, 2) & "/100 "
End If
End If
If Estilo1 = 5 Then
TFNumero = TFNumero & ")"
Else
If Estilo1 <> 1 Then
TFNumero = TFNumero & moneda ' REv Modeda
End If
End If
End If
Upper_Lower:
Select Case Estilo
Case 1 ' TEXTO EN MAYUSCULAS
TFNumero = StrConv(TFNumero, vbUpperCase)
Case 2 ' texto en minusculas
TFNumero = StrConv(TFNumero, vbLowerCase)
Case 3 ' Tipo Titulo
TFNumero = StrConv(TFNumero, vbProperCase)
Case 4 ' Tipo Oración: Primera palabra en mayúsculas.
letra1 = Left(TFNumero, 1)
letra1 = StrConv(letra1, vbUpperCase)
letra2 = Right(TFNumero, Len(TFNumero) - 1)
TFNumero = letra1 + letra2
If Len(TFNumero) > pos1 And pos1 > 0 Then
letra2 = Right(TFNumero, Len(TFNumero) - pos1)
TFNumero = Left(TFNumero, pos1)
letra1 = Left(letra2, 1)
letra1 = TFNumero & StrConv(letra1, vbUpperCase)
letra2 = Right(letra2, Len(letra2) - 1)
End If
TFNumero = letra1 + letra2
Case Else ' sin aplicar cambiois
End Select
salida:
' MsgBox "Ret_NumLet=[" & TFNumero & "]"
NumeLetras = TFNumero
End Function
Private Function NumLet(ByRef param As String, ByVal NumTmp As String, _
ByVal numero As Variant, ByVal uno As Boolean, _
ByVal conAnd As Variant) As String
Dim c01, c02, pos, pos1, dig, cen, dec, uni, i, j, k As Integer
Dim letra1, letra2, letra3, TFNumero As String
Dim Leyenda, s1 As String
Static llones(0 To 15, 0 To 4) As String
llones(0, 0) = "mil" ' Español
llones(1, 0) = "millón"
llones(2, 0) = "billón"
llones(3, 0) = "trillon"
llones(4, 0) = "cuatrillón"
llones(5, 0) = "quintillón"
llones(6, 0) = "sixtillón"
llones(7, 0) = "septillón"
llones(8, 0) = "octillón"
llones(9, 0) = "nonillón"
llones(10, 0) = "decillón"
llones(11, 0) = "undecillón"
llones(12, 0) = "duodecillón"
llones(13, 0) = "tredecillón"
llones(14, 0) = "catordecillón"
llones(15, 0) = "quincedecillón"
llones(0, 1) = "thousand "
llones(1, 1) = "million "
llones(2, 1) = "billion "
llones(3, 1) = "threellion "
llones(4, 1) = "fourtillion "
llones(5, 1) = "fivetillion "
llones(6, 1) = "sixtillion "
llones(7, 1) = "seventillion "
llones(8, 1) = "eightillion "
llones(9, 1) = "ninetillion "
llones(10, 1) = "tentillion "
llones(11, 1) = "elevenllion "
llones(12, 1) = "tweltrillion "
llones(13, 1) = "thirteellion "
llones(14, 1) = "fourteellion "
llones(15, 1) = "fifteellion "
i = Val(Mid(param, 12, 3)) ' Dígitos Parte Entera
j = i Mod 3
If Mid(param, 5, 1) = "1" Then ' Se incluyo comando: Monitor
TFNumero = TFNumero & "{NL-NumTmp=[" & NumTmp & _
"], Len(NumTmp)=" & Len(NumTmp) & _
", uni=" & i & ", decN=" & _
Val(Mid(param, 15, 3)) & ", j=" & j & _
", uno=" & uno & _
", param=[" & param & "], Len(Param)=" & Len(param) & "; "
End If
If j > 0 Then ' Longitud igual a multiplo de 3
letra1 = IIf(j = 1, " ", " ")
j = Len(letra1)
NumTmp = letra1 & NumTmp
i = i + j
param = Left(param, 11) & Format(i, "000") & Mid(param, 15, 9)
End If
c02 = Fix((i + 5) / 6)
dig = c02 - 1 ' Indice Grupo Leyenda
k = 0
If dig > 15 Then
TFNumero = TFNumero & " Número mayor a 78 dígitos [" & NumTmp & "]"
Else
c01 = i - 2
For pos = 1 To c01 Step 3
c02 = 0
Do While c02 <= 2
pos1 = pos + c02
dig = Val(Mid(NumTmp, pos1, 1))
Select Case c02
Case 0: cen = dig
Case 1: dec = dig
Case 2: uni = dig
End Select
c02 = c02 + 1
Loop
letra3 = Centena(uni, dec, cen)
letra2 = Decena(uni, dec)
letra1 = Unidad(uni, dec)
Leyenda = ""
c02 = i - pos + 1
dig = Fix((c02 + 5) / 6)
dig = dig - 1 ' Indice Grupo Leyenda
Select Case c02
Case 3: ' 03-01 |XXX.00
If cen + dec + uni >= 1 Then
Leyenda = ""
End If
Case 6: ' 06-04 |XXX|xxx.00
If cen + dec + uni >= 1 Then
Leyenda = "mil "
If Idioma = 3 And Val(Mid(NumTmp, pos, 3)) = 1 Then
letra1 = "" ' Italiano
ElseIf IsNumeric(numero) And Idioma = 0 And _
Val(Mid(param, 10, 2)) <> 5 Then
If Val(Mid(NumTmp, pos, 3)) = 1 Then ' Quita "un"
letra1 = "" ' "mil" por "un mil"
End If
End If
End If
Case Else:
j = c02 Mod 6 ' i-10 lXXX|xxx|xxx|xxx.00
If j = 0 Then
pos1 = pos + 3
If cen + dec + uni >= 1 And _
Val(Mid(NumTmp, pos1, 3)) = 0 Then
Leyenda = llones(0, 0) & " " & _
llones(dig, 0) & "es "
ElseIf cen + dec + uni >= 1 Then
Leyenda = llones(0, 0) & " "
End If
k = Val(Mid(NumTmp, pos, 3))
Else
' pos1 = pos + 1
If Val(Mid(NumTmp, pos, 3)) = 1 And k = 0 Then
Leyenda = llones(dig, 0) & " "
ElseIf cen + dec + uni >= 1 Then
Leyenda = llones(dig, 0) & "es "
End If
k = 0
End If
End Select
TFNumero = TFNumero + letra3 + letra2 + letra1 + Leyenda
letra3 = ""
Next pos
End If
If Idioma = 3 Then TFNumero = TFNumero & " "
If Mid(param, 18, 3) < 1 And Val(Mid(param, 10, 2)) <> 3 _
And Val(Mid(param, 10, 2)) <> 4 Then
TFNumero = TFNumero & conAnd(Idioma + 20) ' "cero "
' Corrige el caso de uno en lugar de un; Si no se Incluye Moneda
' y el valor de los Dos ultimos dígitos es diferente de 11
ElseIf uno And uni = 1 And dec <> 1 And Idioma = 0 Then
TFNumero = Left(TFNumero, Len(TFNumero) - 1) & "o "
End If
NumLet = TFNumero
End Function
Private Function NExpTex(ByVal sTem As String, ByVal pos As Integer, _
ByVal signo As Boolean) As String
Dim dec, i, j, k, n As Byte
Dim s1, s2 As String
dec = Val(Right(sTem, Len(sTem) - pos - 1))
i = Len(sTem)
s1 = "." ' Num. notación Exponencial
n = InStr(1, sTem, s1, 1) ' CompareMethod.Text
n = n + 1
If dec = 0 Then
s1 = Left(sTem, pos - 1)
Else
s1 = Left(sTem, 1) & Mid(sTem, n, pos - n)
j = Len(s1)
n = dec - 1
If signo Then
If j <= dec Then
i = dec - j + 1
For k = 1 To i
s1 = s1 & "0"
Next k
ElseIf n < j Then
k = n + 2
n = j - k
s1 = Left(s1, k) & "." & Right(s1, n)
End If
Else
If dec = 1 Then
s1 = "0." & s1
Else
sTem = "0."
i = dec - 1
For k = 1 To i
sTem = sTem & "0"
Next k
s1 = sTem & s1
End If
End If
End If
NExpTex = s1
End Function
Private Function comando(ByRef param As String, ByRef sTem As String) As String
Dim scom, s, s1, s0 As String
Dim i, j, k, pos As Integer
Dim com(0 To 5) As String
com(0) = "coma"
com(1) = "punto"
com(2) = "separa"
com(4) = "invcoma" ' Invierte coma por punto y viceversa, similar a siguiente.
com(5) = "invpunto" ' Invierte punto por coma y viceversa, similar a anterior.
com(3) = "monitor"
scom = "%com%" ' Primer comando a Buscar, para separar "conector"
pos = InStr(1, param, scom, 1) 'CompareMethod.Text)
If pos = 0 Then
comando = sTem ' Valores iniciales: coma=","; punto="."; monitor="0"
Else
j = pos - 1 + Len(scom)
s = Right(param, Len(param) - j)
param = Left(param, pos - 1)
s = StrConv(s, vbLowerCase) ' Solo minusculas
s = Trim(s)
Do While Len(s) > 3
i = 1
j = Len(s)
s1 = "" ' Para copiar caracteres "(a-z)" a verisar si es comando
If i <= j Then
Do
s0 = Mid(s, i, 1)
If s0 > Chr(96) And s0 < Chr(123) Then
s1 = s1 & s0
Else
If Len(s1) > 1 Then
i = j + 1
End If
End If
i = i + 1
Loop While i <= j
End If
If Len(s1) = 0 Then
s = "" ' Termina Busqueda comandos
Else
s = Right(s, Len(s) - Len(s1))
If s1 <> "separa" Then s = Trim(s)
For k = 0 To 3
scom = com(k) ' Comando a Buscar
If s1 = scom Then
j = Len(s1) - Len(scom)
If Len(s) >= j Then
s = Right(s, Len(s) - j)
s = Trim(s)
Else
s = ""
End If
If k = 0 Then
If Len(s) > 0 Then ' Cambia del cáracter "punto" si hay cadena
sTem = Left(s, 1) & Mid(sTem, 2, 4)
s = Right(s, Len(s) - 1) ' Reccorre caracter asignado
s = Trim(s)
End If
ElseIf k = 1 Then
If Len(s) > 0 Then ' Cambia del cáracter "coma" si hay cadena
sTem = Left(sTem, 1) & Left(s, 1) & Right(sTem, 3)
s = Right(s, Len(s) - 1) ' Reccorre caracter asignado
s = Trim(s)
End If
ElseIf k = 2 Then ' separa
If Len(s) > 0 Then ' And Left(s, 1) <> " "
' Cambia 3er cáracter "separa" si hay cadena
sTem = Left(sTem, 2) & Left(s, 1) & "1" & Right(sTem, 1)
s = Right(s, Len(s) - 1) ' Reccorre caracter asignado
Else
sTem = Left(sTem, 3) & "1" & Right(sTem, 1)
End If
s = Trim(s)
ElseIf k = 3 Then
sTem = Left(sTem, 4) & "1" ' Monitor
ElseIf k = 4 Or k = 5 Then
sTem = Mid(sTem, 2, 1) & Left(sTem, 1) & Right(sTem, 3)
End If
k = 4
End If
Next k
End If
Loop
comando = sTem
End If
End Function
Private Function Centena(ByVal uni As Integer, ByVal dec As Integer, _
ByVal cen As Integer) As String
Dim cTexto As String
If Idioma = 0 Then ' Español
Select Case cen
Case 1
If dec + uni = 0 Then
cTexto = "cien "
Else
cTexto = "ciento "
End If
Case 2: cTexto = "doscientos "
Case 3: cTexto = "trescientos "
Case 4: cTexto = "cuatrocientos "
Case 5: cTexto = "quinientos "
Case 6: cTexto = "seiscientos "
Case 7: cTexto = "setecientos "
Case 8: cTexto = "ochocientos "
Case 9: cTexto = "novecientos "
Case Else: cTexto = ""
End Select
ElseIf Idioma = 1 Then ' English
If cen <> 0 Then
cTexto = Unidad(cen, 0) & " hundred "
End If
ElseIf Idioma = 2 Then ' Français
If cen <> 0 Then
If cen = 1 Then
cTexto = "cent "
Else
cTexto = Unidad(cen, 0) & " cent "
End If
End If
ElseIf Idioma = 3 Then ' Italiano
If cen <> 0 Then
If cen = 1 Then
cTexto = "cento "
Else
cTexto = Unidad(cen, 0) & "cento "
End If
Else
cTexto = ""
End If
Centena = cTexto
ElseIf Idioma = 4 Then ' Português
Select Case cen
Case 1
If dec + uni = 0 Then
cTexto = "cem "
Else
cTexto = "cento "
End If
Case 2: cTexto = "duzentos "
Case 3: cTexto = "trezentos "
Case 4: cTexto = "quatrocentos "
Case 5: cTexto = "quinhentos "
Case 6: cTexto = "seiscentos "
Case 7: cTexto = "setecentos "
Case 8: cTexto = "oitocentos "
Case 9: cTexto = "novecentos "
Case Else: cTexto = ""
End Select
If uni + dec > 0 And Len(cTexto) > 0 Then
cTexto = cTexto & "e "
End If
End If
Centena = cTexto
End Function
Private Function Decena(ByVal uni As Integer, _
ByVal dec As Integer) As String
Dim n As Byte
Dim cTexto As String
Static Dixaines(0 To 9, 1 To 4) As String
Static decine(0 To 9) As String ' Decenas Italiano
Dixaines(0, 1) = "ten " ' English
Dixaines(1, 1) = "eleven "
Dixaines(2, 1) = "twelve "
Dixaines(3, 1) = "thirteen "
Dixaines(4, 1) = "fourteen "
Dixaines(5, 1) = "fifteen "
Dixaines(6, 1) = "sixteen "
Dixaines(7, 1) = "seventeen "
Dixaines(8, 1) = "eighteen "
Dixaines(9, 1) = "nineteen "
Dixaines(0, 2) = "dix " ' Français
Dixaines(1, 2) = "onze "
Dixaines(2, 2) = "douze "
Dixaines(3, 2) = "treize "
Dixaines(4, 2) = "quatorze "
Dixaines(5, 2) = "quinze "
Dixaines(6, 2) = "seize "
Dixaines(7, 2) = "dix-sept "
Dixaines(8, 2) = "dix-huit "
Dixaines(9, 2) = "dix-neuf "
Dixaines(0, 3) = "dieci" ' Italiano
Dixaines(1, 3) = "undici"
Dixaines(2, 3) = "dodoci"
Dixaines(3, 3) = "tredici"
Dixaines(4, 3) = "quattordici"
Dixaines(5, 3) = "quindici"
Dixaines(6, 3) = "sedici"
Dixaines(7, 3) = "diciassette"
Dixaines(8, 3) = "diciotto"
Dixaines(9, 3) = "diciannove"
Dixaines(0, 4) = "dez " ' Português
Dixaines(1, 4) = "onze "
Dixaines(2, 4) = "doze "
Dixaines(3, 4) = "treze "
Dixaines(4, 4) = "quatorze "
Dixaines(5, 4) = "quinze "
Dixaines(6, 4) = "dezessei "
Dixaines(7, 4) = "dezessete "
Dixaines(8, 4) = "dezoito "
Dixaines(9, 4) = "dezenove"
decine(0) = ""
decine(1) = "dieci"
decine(2) = "venti" ' Italiano Decenas
decine(3) = "trenta"
decine(4) = "quaranta"
decine(5) = "cinquanta"
decine(6) = "sessanta"
decine(7) = "settanta"
decine(8) = "ottanta"
decine(9) = "novanta"
If Idioma = 0 Then ' Español
Select Case dec
Case 1:
Select Case uni
Case 0: cTexto = "diez "
Case 1: cTexto = "once "
Case 2: cTexto = "doce "
Case 3: cTexto = "trece "
Case 4: cTexto = "catorce "
Case 5: cTexto = "quince "
Case 6 To 9: cTexto = "dieci"
End Select
Case 2:
If uni = 0 Then
cTexto = "veinte "
ElseIf uni > 0 Then
cTexto = "veinti"
End If
Case 3: cTexto = "treinta "
Case 4: cTexto = "cuarenta "
Case 5: cTexto = "cincuenta "
Case 6: cTexto = "sesenta "
Case 7: cTexto = "setenta "
Case 8: cTexto = "ochenta "
Case 9: cTexto = "noventa "
Case Else: cTexto = ""
End Select
If uni > 0 And dec > 2 Then cTexto = cTexto + "y "
ElseIf Idioma = 1 Then ' English
Select Case dec
Case 1: cTexto = Dixaines(uni, Idioma) ' cTexto = "ten "
Case 2: cTexto = "twenty "
Case 3: cTexto = "thirty "
Case 4: cTexto = "forty "
Case 5: cTexto = "fifty "
Case 6: cTexto = "sixty "
Case 7: cTexto = "seventy "
Case 8: cTexto = "eighty "
Case 9: cTexto = "ninety "
End Select
ElseIf Idioma = 2 Then ' Français
Select Case dec
Case 1: cTexto = Dixaines(uni, Idioma) ' cTexto = "dix "
Case 2: cTexto = "vingt "
Case 3: cTexto = "trente "
Case 4: cTexto = "quarante "
Case 5: cTexto = "cinquante "
Case 6: cTexto = "soixante "
Case 7: cTexto = "soixante " & Dixaines(uni, Idioma)
Case 8: cTexto = "quatre-vingt "
Case 9: cTexto = "quatre-vingt " & Dixaines(uni, Idioma)
Case Else: cTexto = ""
End Select
ElseIf Idioma = 3 Then ' Italiano
If dec = 0 Then
cTexto = ""
ElseIf dec = 1 Then
cTexto = Dixaines(uni, Idioma)
ElseIf uni = 1 Or uni = 8 Then
n = Len(decine(dec)) - 1
cTexto = Left(decine(dec), n)
Else
cTexto = decine(dec)
End If
ElseIf Idioma = 4 Then ' Português
Select Case dec
Case 1: cTexto = Dixaines(uni, Idioma) ' cTexto = "dix "
Case 2: cTexto = "vinte "
Case 3: cTexto = "trinta "
Case 4: cTexto = "quarenta "
Case 5: cTexto = "cinqüenta "
Case 6: cTexto = "sessenta "
Case 7: cTexto = "setenta "
Case 8: cTexto = "oitenta "
Case 9: cTexto = "noventa "
Case Else: cTexto = ""
End Select
If dec > 1 And uni > 0 And Len(cTexto) > 0 Then
cTexto = cTexto & "e "
End If
End If
Decena = cTexto
End Function
Private Function Unidad(ByVal uni As Integer, ByVal dec As Integer) As String
Dim cTexto As String
Static Unites(0 To 9, 1 To 4) As String
Unites(0, 1) = "" ' "zero"
Unites(1, 1) = "one "
Unites(2, 1) = "two "
Unites(3, 1) = "three "
Unites(4, 1) = "four "
Unites(5, 1) = "five "
Unites(6, 1) = "six "
Unites(7, 1) = "seven "
Unites(8, 1) = "eight "
Unites(9, 1) = "nine "
Unites(0, 2) = "" ' "zero"
Unites(1, 2) = "un "
Unites(2, 2) = "deux "
Unites(3, 2) = "trois "
Unites(4, 2) = "quatre "
Unites(5, 2) = "cinq "
Unites(6, 2) = "six "
Unites(7, 2) = "sept "
Unites(8, 2) = "huit "
Unites(9, 2) = "neuf "
Unites(0, 3) = "" ' Italiano Sin Espacio "zero"
Unites(1, 3) = "uno"
Unites(2, 3) = "due"
Unites(3, 3) = "tre"
Unites(4, 3) = "quattro"
Unites(5, 3) = "cinque"
Unites(6, 3) = "sei"
Unites(7, 3) = "sette"
Unites(8, 3) = "otto"
Unites(9, 3) = "nove"
Unites(0, 4) = "" ' Português "zero"
Unites(1, 4) = "um "
Unites(2, 4) = "dois "
Unites(3, 4) = "três "
Unites(4, 4) = "quatro "
Unites(5, 4) = "cinco "
Unites(6, 4) = "seis "
Unites(7, 4) = "sete "
Unites(8, 4) = "oito "
Unites(9, 4) = "nove "
If Idioma = 0 Then ' Español
If dec <> 1 Then
Select Case uni
Case 1: cTexto = "un "
Case 2: cTexto = IIf(dec = 2, "dós ", "dos ")
Case 3: cTexto = IIf(dec = 2, "trés ", "tres ")
Case 4: cTexto = "cuatro "
Case 5: cTexto = "cinco "
Case Else: cTexto = ""
End Select
End If
Select Case uni
Case 6:
If dec = 2 Or dec = 1 Then ' Falla Insruccíon IIF con 2
cTexto = "séis " ' condiciones se utilizaa IF
Else
cTexto = "seis "
End If
Case 7: cTexto = "siete "
Case 8: cTexto = "ocho "
Case 9: cTexto = "nueve "
End Select
ElseIf Idioma = 1 Then ' English
If dec <> 1 Then
cTexto = Unites(uni, Idioma)
End If
ElseIf Idioma = 2 Then ' Français
If dec <> 1 And dec <> 7 And dec <> 9 Then
cTexto = Unites(uni, Idioma)
End If
ElseIf Idioma = 3 Then ' Italiano
If dec <> 1 Then
cTexto = Unites(uni, Idioma)
End If
ElseIf Idioma = 4 Then ' Português
If dec <> 1 Then
cTexto = Unites(uni, Idioma)
End If
End If
Unidad = cTexto
End Function
Función para convertir números a Texto para Excel, progrmada en Visual Basic
La función permite convertir números hasta de
78 dígitos en Español, incluye
opciones para converit a 4 idiomas adicionales: Inglés, Francés, Italiano y Portuques. Tiene un avance del 85%.
La función permite convertir números hasta de
78 dígitos en Español, incluye
opciones para converit a 4 idiomas adicionales: Inglés, Francés, Italiano y Portuques. Tiene un avance del 85%.
Be the first to comment
You can use [html][/html], [css][/css], [php][/php] and more to embed the code. Urls are automatically hyperlinked. Line breaks and paragraphs are automatically generated.