Corregir errores en macros de excel
Deseo que los números en letras de los decimales estén en mayúsculas
Function Calificaciones(numero As Double) As String
Dim Numdecimales As Double
Dim ParteEntera, Partedecimal
Dim resultado As String
Dim resultado2 As String
'Churoche denle un like y apoyen si les gustó----------------------------------
'Creamos las tablas de conversión de números a letras
parteentera = array("cero", "uno", "dos", "tres", "cuatro", "cinco", "seis", "siete", "ocho", "nueve", "diez", "once", "doce", "trece", "catorce", "quince", "dieciséis", "diecisiete", "dieciocho", "diecinueve", "veinte", "veintiuno", "veintidós", "veintitrés", "veinticuatro", "veinticinco", "veintiséis", "veintisiete", "veintiocho", "veintinueve")
Partedecimal = Array("", "DIEZ", "VEINTE", "TREINTA", "CUARENTA", "CINCUENTA", "SESENTA", "SETENTA", "OCHENTA", "NOVENTA")
'Extraemos la parte entera del número y la llamamos entero
Entero = Fix(numero)
'Redondeamos y extraemos el número de decimales de nuestro número a 2 lo llamamos Numdecimales
Numdecimales = Application.WorksheetFunction.Round((numero - Fix(numero)) * 100, 2)
'Ahora vamos trabajar con el entero dependiendo del valor que tenga
Select Case Entero
'Si el entero tiene un valor de cero pues su texto correspondiente es ese mismo
Case 0
resultado = "CERO"
'Si el entero tiene un valor de entre uno y diez que busque su texto en la tabla ParteEntera
Case 1 To 10
resultado = ParteEntera(Entero)
End Select
'Ahora trabajamos con los decimales
Select Case Numdecimales
'Si no hay decimales el texto que devolverá será cero cero
Case 0
resultado2 = "CERO CERO"
'Si el decimal va desde 01 a 09 pues se encadenará la palabra cero con el texto correspondiente buscando en la tabla
'ParteEntera y se vuelve todo en mayúsculas
Case 1 To 9
resultado2 = LCase(" CERO " & ParteEntera(Numdecimales))
'Si los decimales están entre 10 y 29 se busca su texto en la tabla ParteEntera Y se vuelve a Mayúscula todo el texto
Case 10 To 29
resultado2 = LCase(ParteEntera(Numdecimales))
'Por último si los decimales están entre 30 y 99 hay encadenar las decenas y unidades del mismo
Case 30 To 99
resultado2 = LCase(Partedecimal(Fix(Numdecimales / 10)) & IIf((Numdecimales Mod 10) <> 0, " Y " & ParteEntera(Numdecimales Mod 10), ""))
End Select
Calificaciones = resultado & " COMA " & resultado2
'Aquí se une la parte entera (resultado) con la palabra "coma" y con la parte decimal (resultado2)
End Function
1 respuesta
Si quieres que todo quede en mayúsculas, cambia esta línea:
Calificaciones = resultado & " COMA " & resultado2
Por esta:
Calificaciones = UCase(resultado) & " COMA " & UCase(resultado2)
Si solamente quieres los decimales en mayúsculas, entonces por esta:
Calificaciones = resultado & " COMA " & UCase(resultado2)
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
¡Gracias! Me sirvió de mucho..
Hola me podría ayudar con este código para que las calificaiones salgan de la siguiente manera: 6.00 en letras seis punto cero cero
Function CONVERTIRNUM(numero As Double, Optional CentimosEnLetra As Boolean) As String
Dim Moneda As String
Dim Monedas As String
Dim Centimo As String
Dim Centimos As String
Dim Preposicion As String
Dim NumCentimos As Double
Dim Letra As String
Const Maximo = 10
'************************************************************
' Parámetros
'************************************************************
Moneda = "COMA" 'Nombre de Moneda (Singular)
Monedas = "COMA" 'Nombre de Moneda (Plural)
Centimo = "" 'Nombre de Céntimos (Singular)
Centimos = "CERO" 'Nombre de Céntimos (Plural)
Preposicion = "" 'Preposición entre Moneda y Céntimos
'************************************************************
'Validar que el Numero está dentro de los límites
If (numero >= 0) And (numero <= Maximo) Then
Letra = NUMERORECURSIVO((Fix(numero))) 'Convertir el Numero en letras
'Si Numero = 1 agregar leyenda Moneda (Singular)
If (numero = 1) Then
Letra = Letra & " " & Moneda
'De lo contrario agregar leyenda Monedas (Plural)
Else
Letra = Letra & " " & Monedas
End If
NumCentimos = Round((numero - Fix(numero)) * 100) 'Obtener los centimos del Numero
'Si NumCentimos es mayor a cero inicar la conversión
If NumCentimos >= 0 Then
'Si el parámetro CentimosEnLetra es VERDADERO obtener letras para los céntimos
If CentimosEnLetra Then
decimales = NUMERORECURSIVO(Fix(NumCentimos)) 'Convertir los céntimos en letra
If NumCentimos >= 1 And NumCentimos < 10 Then
decimales = "CERO " & decimales
End If
Letra = Letra & " " & Preposicion & " " & decimales
'Si NumCentimos = 1 agregar leyenda Centimos (Singular)
If (NumCentimos = 1) Then
Letra = Letra & " " & Centimo
'De lo contrario agregar leyenda Centimos (Plural)
Else
Letra = Letra & " " & Centimos
End If
'De lo contrario mostrar los céntimos como número
Else
If NumCentimos < 10 Then
Letra = Letra & " 0" & NumCentimos & "/100"
Else
Letra = Letra & " " & NumCentimos & "/100"
End If
End If
End If
'Regresar el resultado final de la conversión
CONVERTIRNUM = Letra
Else
'Si el Numero no está dentro de los límites, entivar un mensaje de error
CONVERTIRNUM = "ERROR: El número excede los límites."
End If
End Function
Function NUMERORECURSIVO(numero As Long) As String
Dim Unidades, Decenas, Centenas
Dim resultado As String
'**************************************************
' Nombre de los números
'**************************************************
Unidades = array("", "uno", "dos", "tres", "cuatro", "cinco", "seis", "siete", "ocho", "nueve", "diez", "once", "doce", "trece", "catorce", "quince", "dieciséis", "diecisiete", "dieciocho", "diecinueve", "veinte", "veintiuno", "veintidos", "veintitres", "veinticuatro", "veinticinco", "veintiseis", "veintisiete", "veintiocho", "veintinueve")
Decenas = Array("", "DIEZ", "VEINTE", "TREINTA", "CUARENTA", "CINCUENTA", "SESENTA", "SETENTA", "OCHENTA", "NOVENTA", "CIEN")
Centenas = array("", "ciento", "doscientos", "trescientos", "cuatrocientos", "quinientos", "seiscientos", "setecientos", "ochocientos", "novecientos")
'**************************************************
Select Case numero
Case 0
resultado = "CERO"
Case 1 To 29
resultado = Unidades(numero)
Case 30 To 100
resultado = Decenas(numero \ 10) + IIf(numero Mod 10 <> 0, " Y " + NUMERORECURSIVO(numero Mod 10), "")
Case 101 To 999
resultado = Centenas(numero \ 100) + IIf(numero Mod 100 <> 0, " " + NUMERORECURSIVO(numero Mod 100), "")
Case 1000 To 1999
resultado = "Mil" + IIf(numero Mod 1000 <> 0, " " + NUMERORECURSIVO(numero Mod 1000), "")
Case 2000 To 999999
resultado = NUMERORECURSIVO(numero \ 1000) + " Mil" + IIf(numero Mod 1000 <> 0, " " + NUMERORECURSIVO(numero Mod 1000), "")
Case 1000000 To 1999999
resultado = "Un Millón" + IIf(numero Mod 1000000 <> 0, " " + NUMERORECURSIVO(numero Mod 1000000), "")
Case 2000000 To 1999999999
resultado = NUMERORECURSIVO(numero \ 1000000) + " Millones" + IIf(numero Mod 1000000 <> 0, " " + NUMERORECURSIVO(numero Mod 1000000), "")
End Select
NUMERORECURSIVO = resultado
End Function
Pero esta es otra función.
Con mucho gusto te ayudo con todas tus peticiones.
Crea una nueva pregunta en Todoexpertos dentro del tema de microsoft excel. En el desarrollo de la pregunta escribe: "para Dante Amor". Ahí me describes con detalle lo que necesitas.
Sal u dos
Hola no me deja copiar la función anterior para realizar una nueva pregunta que puedo hacer
Plantea la nueva pregunta y haz referencia a esta pregunta.
