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.

1 respuesta

Respuesta
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?
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.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas