Hola, experto favorito: Venga, la siguiente pregunta no es de urgencia, solo por curiosear y cacharrear el Excel. Desde el momento que me diste las instrucciones de la macro para convertíos a pesos colombianos, no he hecho sino fascinarme con su gran utilidad. De otro lado, os comento que tengo curiosidad por lo siguiente: He creado otra plantilla en la que con base en tu macro, necesito colocar la cifra solita en letras: por ejemplo: escribir en una celda 1000 y que me aparezca automáticamente en otra (según la fórmula) mil.
Según tu macro, al adecuar la función y dejar sólo el resultado para números, pues me viene apareciendo: MIL S. En este caso, la S sobraría. En resumen, mi pregunta es: Podríais ayudaros NO A MODIFICAR LA MACRO PORQUE ES PERFECTA; ¿Pero la función la podríais modificar para que cuando no necesite los PESOS no me incluya la S? Es decir, sin tocar para nada la macro; sólo trabajar con la función para que no refleje la S. Sólo el resultado en letras, exclusivamente. Venga, os agradezco de nuevo tu valioso tiempo, que pena preguntar tanto. Atento a tu respuesta, FERNANDO.
Pues simplemente habría que modificar el código y agregarle otra variable a la fórmula, por ejemplo una variable UM usoMoneda con 1 si es moneda con 0 si no es moneda así si pones (15,1, dolar, 0) te dirían quince si pones (15,1, dolar, 1) te dirían quince dolares en el caso de la variable con 0 habría ademas que modificar la variable moneda para que cuando UM sea 0 la variable moneda sea siempre blanca (vacía). ¿Lo haces tu o lo hago yo?
Venga, que he sido un poco torpe y no he podido efectuar las modificaciones con los parámetros que me diste. Soy muy sincero: no pude, la verdad. Agradecería inmensamente el favor os me ayudarais con ello. Atento a tu respuesta, Fernando.
Mis ojos no dan más, jejej programe demasiado hoy, me daré un descanso. El código con la variable usar moneda quedaría así: Ojo con dolares debes poner como moneda "dolare" no dolar porque te dirá "dolars" Option Explicit Dim cTexto As String 'Variable para las funciones Public Function NumLetras(ByVal Numero As Double, ByVal Mayusculas As Integer, Mon As String, UsoMoneda As Boolean) As String Dim NumTmp As String Dim c01 As Integer Dim c02 As Integer Dim pos As Integer Dim dig As Integer Dim decc As Integer Dim unic As Integer Dim letrac1 As String Dim letrac2 As String Dim fin As String Dim cen As Integer Dim dec As Integer Dim uni As Integer Dim letra1 As String Dim letra2 As String Dim letra3 As String Dim Leyenda As String Dim Leyenda1 As String Dim TFNumero As String Dim centavos As String If Numero < 0 Then Numero = Abs(Numero) NumTmp = Format(Numero, "000000000000000.00") 'Le da un formato fijo c01 = 1 pos = 1 TFNumero = "" 'Para extraer tres digitos cada vez Do While c01 <= 5 c02 = 1 Do While c02 <= 3 'Extrae un dígito cada vez de izquierda a derecha dig = Val(Mid(NumTmp, pos, 1)) Select Case c02 Case 1: cen = dig Case 2: dec = dig Case 3: uni = dig End Select c02 = c02 + 1 pos = pos + 1 Loop letra3 = Centena(uni, dec, cen) letra2 = Decena(uni, dec) letra1 = Unidad(uni, dec) If c01 = 4 Then If Val(Mid(NumTmp, 10, 3)) = 1 Then letra1 = "" Else letra1 = Unidad(uni, dec) End If End If Select Case c01 Case 1 If cen + dec + uni = 1 Then Leyenda = "Billon " ElseIf cen + dec + uni > 1 Then Leyenda = "Billones " End If Case 2 If cen + dec + uni >= 1 And Val(Mid(NumTmp, 7, 3)) = 0 Then Leyenda = "Mil Millones " ElseIf cen + dec + uni >= 1 Then Leyenda = "Mil " End If Case 3 If cen + dec = 0 And uni = 1 Then Leyenda = "Millon " ElseIf cen > 0 Or dec > 0 Or uni > 1 Then Leyenda = "Millones " End If Case 4 If cen + dec + uni >= 1 Then Leyenda = "Mil " End If Case 5 If cen + dec + uni >= 1 Then Leyenda = "" End If End Select c01 = c01 + 1 TFNumero = TFNumero + letra3 + letra2 + letra1 + Leyenda Leyenda = "" letra1 = "" letra2 = "" letra3 = "" Loop '------- If UsoMoneda = 0 Then If Val(NumTmp) = 0 Or Val(NumTmp) < 1 Then Leyenda1 = "Cero " ElseIf Val(NumTmp) = 1 Or Val(NumTmp) < 2 Then Leyenda1 = " " ElseIf Val(Mid(NumTmp, 4, 12)) = 0 Or Val(Mid(NumTmp, 10, 6)) = 0 Then Leyenda1 = "de " Else Leyenda1 = " " End If End If '------- If Mid(NumTmp, 17, 2) > 0 Then ' Centavos decc = Val(Mid(NumTmp, 17, 1)) unic = Val(Mid(NumTmp, 18, 1)) letrac2 = Decena(unic, decc) letrac1 = Unidad(unic, decc) '--------------- centavos = " con " If UsoMoneda = 0 Then If Mid(NumTmp, 17, 2) > 1 Then fin = " centavos" Else fin = " centavo" End If End If Else centavos = " " letrac1 = "" letrac2 = "" fin = "" End If If UsoMoneda = 0 Then If Val(Mid(NumTmp, 1, 15)) > 1 Then Mon = Mon & "s" End If End If TFNumero = TFNumero & Leyenda1 & Mon & centavos & letrac2 & letrac1 & fin If Mayusculas = 1 Then TFNumero = UCase(TFNumero) Else TFNumero = LCase(TFNumero) End If NumLetras = TFNumero End Function Private Function Centena(ByVal uni As Integer, ByVal dec As Integer, _ ByVal cen As Integer) As String 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 Centena = cTexto cTexto = "" End Function Private Function Decena(ByVal uni As Integer, ByVal dec As Integer) As String 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 " Decena = cTexto cTexto = "" End Function Private Function Unidad(ByVal uni As Integer, ByVal dec As Integer) As String If dec <> 1 Then Select Case uni Case 1: cTexto = "un " Case 2: cTexto = "dos " Case 3: cTexto = "tres " Case 4: cTexto = "cuatro " Case 5: cTexto = "cinco " End Select End If Select Case uni Case 6: cTexto = "seis " Case 7: cTexto = "siete " Case 8: cTexto = "ocho " Case 9: cTexto = "nueve " End Select Unidad = cTexto cTexto = "" End Function
Venga, que sin más halagos os doy mis agradecimientos por tu grandiosa colaboración. Atinaste 100% a resolver mis dudas. Mis sinceras gracias. Eres un experto de primera linea. Gracias por tu tiempo, tu paciencia y por tus prontas respuestas. Caluroso saludo, Fernando.