Función para convertir números a Letras para Excel, programada en Visual Basic (VBA) La función permite convertir números hasta de 78 dígitos En Español + 4 Idiomas.

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%.

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.