Ver Mensaje Individual
  #62 (permalink)  
Antiguo 06/04/2005, 11:00
Avatar de pablinweb
pablinweb
 
Fecha de Ingreso: julio-2003
Mensajes: 283
Antigüedad: 21 años, 3 meses
Puntos: 0
Importe a letras

Código:
<%
Function ImporteEnLetras(pImporte, pSepDecimal, pCharPorLinea, pDesMoneda, pDesCentavos, pDecimalesEnNumeros, pLeyenda)

Dim tmpEntero(9)
Dim tmpDecimal(2)
Dim tmpImporteEnLetras
Dim tmpLetrasFinal
Dim tmpEsDecimal
Dim tmpImporte
Dim tmpEnteros
Dim tmpDecimales
Dim tmpChar
Dim i
Dim tmpLargoImporte
Dim tmpLargoEnteros
Dim tmpPosicion
Dim tmpDigito
Dim tmpCantChar
Dim tmpPalabra

ImporteEnLetras = ""

tmpImporteEnLetras = ""
tmpLetrasFinal = ""
tmpImporte = Trim(pImporte)
tmpEsDecimal = False
tmpEnteros = ""
tmpDecimales = ""

For i = 1 To Len(tmpImporte)
  tmpChar = Mid(tmpImporte, i, 1)
  If tmpChar <> pSepDecimal And (Asc(tmpChar) < 48 Or Asc(tmpChar) > 57) Then
    Exit Function
  End If
Next

For i = 1 To 9
  tmpEntero(i) = "0"
Next

tmpLargoImporte = Len(tmpImporte)

For tmpPosicion = 1 To tmpLargoImporte
  tmpChar = Mid(tmpImporte, tmpPosicion, 1)
  If tmpChar = pSepDecimal Then
    tmpEsDecimal = True
  Else
    If tmpEsDecimal = True Then
      tmpDecimales = tmpDecimales + tmpChar
    Else
      tmpEnteros = tmpEnteros + tmpChar
    End If
  End If
Next

tmpDecimales = Left(tmpDecimales + "00", 2)
tmpLargoEnteros = Len(tmpEnteros)

For tmpDigito = tmpLargoEnteros To 1 Step -1
  tmpEntero(tmpDigito) = Mid(tmpEnteros, (tmpLargoEnteros - tmpDigito + 1), 1)
Next

If (tmpEntero(9) <> "0" Or tmpEntero(8) <> "0" Or tmpEntero(7) <> "0") Then
  tmpImporteEnLetras = tmpImporteEnLetras + ConvierteLetras(tmpEntero(9), tmpEntero(8), tmpEntero(7))
  If (tmpEntero(9) = "0" And tmpEntero(8) = "0" And tmpEntero(7) = "1") Then
    tmpImporteEnLetras = tmpImporteEnLetras + "millon "
  Else
    tmpImporteEnLetras = tmpImporteEnLetras + "millones "
  End If
End If

If (tmpEntero(6) <> "0" Or tmpEntero(5) <> "0" Or tmpEntero(4) <> "0") Then
  If (tmpEntero(6) = "0" And tmpEntero(5) = "0" And tmpEntero(4) = "1") Then
  Else
    tmpImporteEnLetras = tmpImporteEnLetras + ConvierteLetras(tmpEntero(6), tmpEntero(5), tmpEntero(4))
  End If
  tmpImporteEnLetras = tmpImporteEnLetras + "mil "
End If

tmpImporteEnLetras = tmpImporteEnLetras + ConvierteLetras(tmpEntero(3), tmpEntero(2), tmpEntero(1))
If tmpEntero(1) = "1" Then tmpImporteEnLetras = Left(tmpImporteEnLetras, Len(tmpImporteEnLetras) - 1) + "o "

If tmpImporteEnLetras = "" Then tmpImporteEnLetras = "cero "
If pDecimalesEnNumeros = True Then
   tmpImporteEnLetras = tmpImporteEnLetras + pDesMoneda + " con " + tmpDecimales + "/100 " + pDesCentavos
Else
   tmpDecimal(1) = Mid(tmpDecimales, 1, 1)
   tmpDecimal(2) = Mid(tmpDecimales, 2, 1)
   tmpImporteEnLetras = tmpImporteEnLetras + pDesMoneda + " con " + ConvierteLetras("0", tmpDecimal(1), tmpDecimal(2)) + pDesCentavos
End If

tmpImporteEnLetras = RTrim(tmpImporteEnLetras)

If Len(tmpImporteEnLetras) <= pCharPorLinea Then
  tmpLetrasFinal = tmpImporteEnLetras
Else
  tmpCantChar = 0
  tmpPalabra = ""
  For i = 1 To Len(tmpImporteEnLetras)
    tmpCantChar = tmpCantChar + 1
    tmpChar = Mid(tmpImporteEnLetras, i, 1)
    If tmpChar = " " Then
      tmpLetrasFinal = tmpLetrasFinal + tmpPalabra
      tmpPalabra = ""
      If tmpCantChar < pCharPorLinea Then tmpLetrasFinal = tmpLetrasFinal + tmpChar
    Else
      tmpPalabra = tmpPalabra + tmpChar
    End If
    If tmpCantChar > pCharPorLinea Then
      tmpCantChar = Len(tmpPalabra)
      
    If gCHARLINE Then
      tmpLetrasFinal = tmpLetrasFinal & vbCrLf
    Else
      tmpLetrasFinal = tmpLetrasFinal + Chr(10)
    End If

    End If
  Next
  tmpLetrasFinal = tmpLetrasFinal + tmpPalabra
End If

If pLeyenda = "" Then
    ImporteEnLetras = UCase(tmpLetrasFinal)
Else
    ImporteEnLetras = UCase(tmpLetrasFinal & " " & pLeyenda)
End If

End Function
Function ConvierteLetras(pDigito3, pDigito2, pDigito1)

Dim tmpLetras

ConvierteLetras = ""
tmpLetras = ""

Select Case pDigito3
  Case "0"
  Case "1"
    If pDigito2 = "0" And pDigito1 = "0" Then
      tmpLetras = tmpLetras + "cien "
    Else
      tmpLetras = tmpLetras + "ciento "
    End If
  Case "2"
    tmpLetras = tmpLetras + "doscientos "
  Case "3"
    tmpLetras = tmpLetras + "trescientos "
  Case "4"
    tmpLetras = tmpLetras + "cuatrocientos "
  Case "5"
    tmpLetras = tmpLetras + "quinientos "
  Case "6"
    tmpLetras = tmpLetras + "seiscientos "
  Case "7"
    tmpLetras = tmpLetras + "setecientos "
  Case "8"
    tmpLetras = tmpLetras + "ochocientos "
  Case "9"
    tmpLetras = tmpLetras + "novecientos "
  Case Else
    Exit Function
End Select

Select Case pDigito2
  Case "0"
  Case "1"
    Select Case pDigito1
      Case "0"
        tmpLetras = tmpLetras + "diez "
      Case "1"
        tmpLetras = tmpLetras + "once "
      Case "2"
        tmpLetras = tmpLetras + "doce "
      Case "3"
        tmpLetras = tmpLetras + "trece "
      Case "4"
        tmpLetras = tmpLetras + "catorce "
      Case "5"
        tmpLetras = tmpLetras + "quince "
      Case "6"
        tmpLetras = tmpLetras + "dieciseis "
      Case "7"
        tmpLetras = tmpLetras + "diecisiete "
      Case "8"
        tmpLetras = tmpLetras + "dieciocho "
      Case "9"
        tmpLetras = tmpLetras + "diecinueve "
      Case Else
        Exit Function
    End Select
  Case "2"
    If pDigito1 = "0" Then
      tmpLetras = tmpLetras + "veinte "
    Else
      tmpLetras = tmpLetras + "veinti"
    End If
  Case "3"
    tmpLetras = tmpLetras + "treinta "
  Case "4"
    tmpLetras = tmpLetras + "cuarenta "
  Case "5"
    tmpLetras = tmpLetras + "cincuenta "
  Case "6"
    tmpLetras = tmpLetras + "sesenta "
  Case "7"
    tmpLetras = tmpLetras + "setenta "
  Case "8"
    tmpLetras = tmpLetras + "ochenta "
  Case "9"
    tmpLetras = tmpLetras + "noventa "
  Case Else
    Exit Function
End Select
If cdbl(pDigito2) >= 3 And pDigito1 <> "0" Then tmpLetras = tmpLetras + "y "

If pDigito2 <> "1" Then
  Select Case pDigito1
    Case "0"
    Case "1"
      tmpLetras = tmpLetras + "un "
    Case "2"
      tmpLetras = tmpLetras + "dos "
    Case "3"
      tmpLetras = tmpLetras + "tres "
    Case "4"
      tmpLetras = tmpLetras + "cuatro "
    Case "5"
      tmpLetras = tmpLetras + "cinco "
    Case "6"
      tmpLetras = tmpLetras + "seis "
    Case "7"
      tmpLetras = tmpLetras + "siete "
    Case "8"
      tmpLetras = tmpLetras + "ocho "
    Case "9"
      tmpLetras = tmpLetras + "nueve "
    Case Else
      Exit Function
  End Select
End If

ConvierteLetras = tmpLetras

End Function
%>
para llamarla:

tmp = 1234.45
tmp = ImporteEnLetras(tmp, ".", 100, "PESOS", "CENTAVOS", false, "")
response.Write(tmp)


Definición:

pImporte: Monto
pSepDecimal: Separeción de decimales ("," o ".")
pCharPorLinea: Caracteres por linea para que no se salga del ancho requerido
pDesMoneda: Descripción de la moneda ("PESOS", "DOLARES ESTADOUNIDENSES", "EUROS", etc)
pDesCentavos: Descripción de los centavos ("CENTAVOS", "CENTS", etc)
pDecimalesEnNumeros: true = pone los decimales en números ej:12/100. false los pone en letras
pLeyenda: leyenda final que se le puede agregar o no al texto por ejemplo en Mexico se usa "M.N." de moneda nacional

Espero les sea útil...
Si alguien se copa podrian adaptarla para que se pueda elegir el idioma porque hay casos en los que si son dolares te lo piden en ingles.

Última edición por pablinweb; 06/04/2005 a las 11:03