Foros del Web - Ver Mensaje Individual

ccrux713 · #57 (**permalink**) 23/03/2010, 17:21

Buenas tardes,

Aqui de nuevo, estimado uzziber, muchas gracias por tu respuesta y tip. No obstante dado que me es casi imposible ponerme a programa en vba por una importante razon: no soy programador ni estudie nada parecido asi que conozco poco de la materia por lo que me requeriria mucho tiempo leer y poner en practica, es posible que lo hiciera si ahora contara con ese tiempo.

No obstante, casi magicamente llego a mis manos otro codigo que permite hacer esta tarea, lo he probado y parece funcionar al 100%, por lo tanto se los comparto de la misma manera que me lo compartieron:

Código:

Option Explicit
'Argumentos:
'Numeros_Letras(Numero,"Peso",FALSO,"centavo","(","/100 m.n)",3)
'Numero = Valor que deseamos convertir en texto
'Moneda = es el nombre de la moneda a mostrar (peso, euro, libra, sol, lira, dólar)
'Fraccion_Letras = Verdadero para que la fraccion de la moneda
'                 tambien la convierta a letras y FALSO unicamente impore sin fración
'Fraccion = Es el nombre de la fraccion de la moneda
'Texto_Inicial = Cualquier texto que quieras al principio del resultado
'Texto_Final = Cualquier texto que quieras al finla del resultado
'Estilo = Formato de salida
'           1 = MAYUSCULAS
'           2 = minusculas
'           3 = Tipo Titulo
'Los valores negativos los convierte a positivos
'El valor minimo en 0, el valor maximo es  9,999,999,999,999.99

Public Function Numeros_Letras(ByVal Numero As Double, _
                    ByVal Moneda As String, _
                    Optional Fraccion_Letras As Boolean = False, _
                    Optional Fraccion As String = "", _
                    Optional Texto_Inicial As String = "", _
                    Optional Texto_Final As String = "", _
                    Optional Estilo As Integer = 1) As String
Dim strLetras As String
Dim NumTmp As String
Dim intFraccion As Integer

  strLetras = Texto_Inicial
  'Convertimos a positivo si es negativo
  Numero = Abs(Numero)
  NumTmp = Format(Numero, "000000000000000.00")
  If Numero < 1 Then
    strLetras = strLetras & "cero " & Plural(Moneda) & " "
  Else
    strLetras = strLetras & NumLet(Val(Left(NumTmp, 15)))
    If Val(NumTmp) = 1 Or Val(NumTmp) < 2 Then
      strLetras = strLetras & Moneda & " "
    ElseIf Val(Mid(NumTmp, 4, 12)) = 0 Or Val(Mid(NumTmp, 10, 6)) = 0 Then
      strLetras = strLetras & "de " & Plural(Moneda) & " "
    Else
      strLetras = strLetras & Plural(Moneda) & " "
    End If
  End If
  If Fraccion_Letras Then
    intFraccion = Val(Right(NumTmp, 2))
    Select Case intFraccion
      Case 0
        strLetras = strLetras & "con cero " & Plural(Fraccion)
      Case 1
        strLetras = strLetras & "con un " & Fraccion
      Case Else
        strLetras = strLetras & "con " & NumLet(Val(Right(NumTmp, 2))) & Plural(Fraccion)
    End Select
  Else
    strLetras = strLetras & Right(NumTmp, 2)
  End If
  strLetras = strLetras & Texto_Final
  Select Case Estilo
    Case 1
      strLetras = StrConv(strLetras, vbUpperCase)
    Case 2
      strLetras = StrConv(strLetras, vbLowerCase)
    Case 3
      strLetras = StrConv(strLetras, vbProperCase)
  End Select
    
  Numeros_Letras = strLetras
  
End Function

Public Function NumLet(ByVal Numero As Double) As String
  Dim NumTmp As String
  Dim co1 As Integer
  Dim co2 As Integer
  Dim pos As Integer
  Dim dig As Integer
  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 TFNumero As String
        
  NumTmp = Format(Numero, "000000000000000")        'Le da un formato fijo
  co1 = 1
  pos = 1
  TFNumero = ""
  'Para extraer tres digitos cada vez
  Do While co1 <= 5
    co2 = 1
    Do While co2 <= 3
      'Extrae un digito cada vez de izquierda a derecha
      dig = Val(Mid(NumTmp, pos, 1))
      Select Case co2
        Case 1: cen = dig
        Case 2: dec = dig
        Case 3: uni = dig
      End Select
      co2 = co2 + 1
      pos = pos + 1
    Loop
    letra3 = Centena(uni, dec, cen)
    letra2 = Decena(uni, dec)
    letra1 = Unidad(uni, dec)
            
    Select Case co1
      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
            
      co1 = co1 + 1
      TFNumero = TFNumero + letra3 + letra2 + letra1 + Leyenda
      
      Leyenda = ""
      letra1 = ""
      letra2 = ""
      letra3 = ""
  Loop
       
  NumLet = TFNumero
    
End Function

Private Function Centena(ByVal uni As Integer, ByVal dec As Integer, _
                         ByVal cen As Integer) As String
Dim cTexto 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
    
End Function

Private Function Decena(ByVal uni As Integer, ByVal dec As Integer) As String
Dim cTexto 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
  
End Function

Private Function Unidad(ByVal uni As Integer, ByVal dec As Integer) As String
Dim cTexto 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

End Function

'Funcion que convierte al plural el argumento pasado
Private Function Plural(ByVal Palabra As String) As String
Dim pos As Integer
Dim strPal As String

  If Len(Trim(Palabra)) > 0 Then
    pos = InStr(1, "aeiou", Right(Palabra, 1), vbTextCompare)
    If pos > 0 Then
      strPal = Palabra & "s"
    Else
      strPal = Palabra & "es"
    End If
  End If
  Plural = strPal
  
End Function

Por cierto, realmente te sorprendera saber que si existen no solo facturas sino tambien otros tipos de documentos de 1 peso o menores.

Gracias.

Cita:

Iniciado por uzziber

Para efectos prácticos, la macro está bien; no creo que haya facturas de 1 peso ó menores;
Agrega éstas líneas a la macro...

Loop Until (Numero = 0)

If (Letras = "un") Then
num_letras = UCase("(" & Letras & " peso " & (Round(Decimales * 100)) & "/100 M.N.)")
Else
num_letras = UCase("(" & Letras & " pesos " & (Round(Decimales * 100)) & "/100 M.N.)")
End If
End Function

Y llegó el momento de que aprendas algo más de VB; como puedes leer en el hilo, los foreros mejoraron, modificaron y ajustaron a sus necesidades la macro; te toca ajustarla a tus necesidades, ojalá puedas corregir el tema de los "veintemiles" (que ya está hecho) y podrías intentar hacer que cuándo el valor sea "0.55" aparezca en el texto "cero pesos"; luego subes la macro para que otros la puedan usar....

Saludos...