Venga, un pequeñísimo detalle
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.
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.
Respuesta de kapapri
1
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?
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.
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
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.
Caluroso saludo, Fernando.
