convertir cantidades

23/09/2004 - 23:35 por magav | Informe spam
hola
quiero convetir una cantidad numerica en letra, 12.50= doce pesos cincuenta
centavos, las cantidades varian

Saludos
 

Leer las respuestas

#1 Israel
23/09/2004 - 23:48 | Informe spam
Espero te sirva, copiala y pagala en un modulo


Function NumToLetra(ByVal Valor As Double)
Dim mxLongitud As Integer
Dim mxMoneda As String
Dim mxCantidad As String
Dim mxCents As Double, mxUnids As Double, mxCientos As
Double, mxMiles As Double, mxMillones As Double

ReDim ArrmxU(30)
ReDim ArrmxD(10)
ReDim ArrmxC(10)
ArrmxU(0) = " "
ArrmxU(1) = "UN"
ArrmxU(2) = "DOS"
ArrmxU(3) = "TRES"
ArrmxU(4) = "CUATRO"
ArrmxU(5) = "CINCO"
ArrmxU(6) = "SEIS"
ArrmxU(7) = "SIETE"
ArrmxU(8) = "OCHO"
ArrmxU(9) = "NUEVE"
ArrmxU(10) = "DIEZ"
ArrmxU(11) = "ONCE"
ArrmxU(12) = "DOCE"
ArrmxU(13) = "TRECE"
ArrmxU(14) = "CATORCE"
ArrmxU(15) = "QUINCE"
ArrmxU(16) = "DIECISEIS"
ArrmxU(17) = "DIECISIETE"
ArrmxU(18) = "DIECIOCHO"
ArrmxU(19) = "DIECINUEVE"
ArrmxU(20) = "VEINTE"
ArrmxU(21) = "VEINTIUN"
ArrmxU(22) = "VEINTIDOS"
ArrmxU(23) = "VENTITRES"
ArrmxU(24) = "VEINTICUATRO"
ArrmxU(25) = "VEINTICINCO"
ArrmxU(26) = "VEINTISEIS"
ArrmxU(27) = "VEINTISIETE"
ArrmxU(28) = "VEINTIOCHO"
ArrmxU(29) = "VEINTINUEVE"

ArrmxD(0) = " "
ArrmxD(1) = " "
ArrmxD(2) = " "
ArrmxD(3) = "TREINTA"
ArrmxD(4) = "CUARENTA"
ArrmxD(5) = "CINCUENTA"
ArrmxD(6) = "SESENTA"
ArrmxD(7) = "SETENTA"
ArrmxD(8) = "OCHENTA"
ArrmxD(9) = "NOVENTA"

ArrmxC(0) = " "
ArrmxC(1) = "CIEN"
ArrmxC(2) = "DOSCIENTOS"
ArrmxC(3) = "TRESCIENTOS"
ArrmxC(4) = "CUATROCIENTOS"
ArrmxC(5) = "QUINIENTOS"
ArrmxC(6) = "SEISCIENTOS"
ArrmxC(7) = "SETECIENTOS"
ArrmxC(8) = "OCHOCIENTOS"
ArrmxC(9) = "NOVECIENTOS"

mxLongitud = Len(Trim(Valor))
mxMoneda = "Pesos"
mxCantidad = ""

mxUnids = Int(Valor)
mxCents = Round(Valor - mxUnids, 2) * 100
mxMillones = Int(Valor / 1000000)
mxUnids = Int(Valor - mxMillones * 1000000)
mxMiles = Int(mxUnids / 1000)
mxUnids = Int(mxUnids - mxMiles * 1000)

If Valor > 999999999.99 Then
NumToLetra = "Cantidad demasiado grande"
Exit Function
End If

If mxMillones > 0 Then
Select Case Len(Trim(mxMillones))
Case Is = 1
mxCantidad = ArrmxU(mxMillones)
Case Is = 2
If Mid(Trim(mxMillones), 1, 1) < 3 Then
mxCantidad = ArrmxU(mxMillones)
ElseIf Mid(Trim(mxMillones), 1, 1) >= 3 Then
If Mid(Trim(mxMillones), 2, 1) = 0 Then
mxCantidad = ArrmxD(Mid(Trim
(mxMillones), 1, 1))
ElseIf Mid(Trim(mxMillones), 2, 1) >= 1
Then
mxCantidad = ArrmxD(Mid(Trim
(mxMillones), 1, 1)) & " Y " & ArrmxU(Mid(Trim
(mxMillones), 2, 1))
End If
End If
Case Is = 3
If Mid(Trim(mxMillones), 1, 1) = 1 Then
If Mid(Trim(mxMillones), 1, 1) = 1 And Mid
(Trim(mxMillones), 2, 1) = 0 And Mid(Trim(mxMillones), 3,
1) = 0 Then
mxCantidad = ArrmxC(Mid(Trim
(mxMillones), 1, 1))
ElseIf Mid(Trim(mxMillones), 1, 1) = 1 Or
Mid(Trim(mxMillones), 2, 1) <> 0 Or Mid(Trim(mxMillones),
3, 1) <> 0 Then
If Val(Mid(Trim(mxMillones), 2, 2)) <
30 Then
mxCantidad = ArrmxC(Mid(Trim
(mxMillones), 1, 1)) & "TO " & ArrmxU(Mid(Trim
(mxMillones), 2, 2))
ElseIf Val(Mid(Trim(mxMillones), 2,
2)) > 29 Then
If Mid(Trim(mxMillones), 3, 1) = 0
Then
mxCantidad = ArrmxC(Mid(Trim
(mxMillones), 1, 1)) & "TO " & ArrmxD(Mid(Trim
(mxMillones), 2, 1))
ElseIf Mid(Trim(mxMillones), 3, 1)
= 1 Then


mxCantidad = ArrmxC(Mid(Trim
(mxMillones), 1, 1)) & "TO " & ArrmxD(Mid(Trim
(mxMillones), 2, 1)) & " Y " & ArrmxU(Mid(Trim
(mxMillones), 3, 1))
End If
End If
End If
Else
If Mid(Trim(mxMillones), 2, 1) = 0 And Mid
(Trim(mxMillones), 3, 1) = 0 Then
mxCantidad = ArrmxC(Mid(Trim
(mxMillones), 1, 1))
ElseIf Val(Mid(Trim(mxMillones), 2, 2)) <
30 Then
mxCantidad = ArrmxC(Mid(Trim
(mxMillones), 1, 1)) & " " & ArrmxU(Mid(Trim(mxMillones),
2, 2))
ElseIf Val(Mid(Trim(mxMillones), 2, 2)) >
29 Then
If Mid(Trim(mxMillones), 3, 1) = 0 Then
mxCantidad = ArrmxC(Mid(Trim
(mxMillones), 1, 1)) & " " & ArrmxD(Mid(Trim(mxMillones),
2, 1))
ElseIf Mid(Trim(mxMillones), 3, 1) >= 1
Then
mxCantidad = ArrmxC(Mid(Trim
(mxMillones), 1, 1)) & " " & ArrmxD(Mid(Trim(mxMillones),
2, 1)) & " Y " & ArrmxU(Mid(Trim(mxMillones), 3, 1))
End If
End If
End If
End Select
If mxMillones = 1 Then
NumToLetra = mxCantidad & " MILLON "
ElseIf mxMillones > 1 Then
NumToLetra = mxCantidad & " MILLONES "
End If
End If

If mxMiles > 0 Then
Select Case Len(Trim(mxMiles))
Case Is = 1
mxCantidad = ArrmxU(mxMiles)
Case Is = 2
If Mid(Trim(mxMiles), 1, 1) < 3 Then
mxCantidad = ArrmxU(mxMiles)
ElseIf Mid(Trim(mxMiles), 1, 1) >= 3 Then
If Mid(Trim(mxMiles), 2, 1) = 0 Then
mxCantidad = ArrmxD(Mid(Trim(mxMiles),
1, 1))
ElseIf Mid(Trim(mxMiles), 2, 1) >= 1 Then
mxCantidad = ArrmxD(Mid(Trim(mxMiles),
1, 1)) & " Y " & ArrmxU(Mid(Trim(mxMiles), 2, 1))
End If
End If
Case Is = 3
If Mid(Trim(mxMiles), 1, 1) = 1 Then
If Mid(Trim(mxMiles), 1, 1) = 1 And Mid
(Trim(mxMiles), 2, 1) = 0 And Mid(Trim(mxMiles), 3, 1) = 0
Then
mxCantidad = ArrmxC(Mid(Trim(mxMiles),
1, 1))
ElseIf Mid(Trim(mxMiles), 1, 1) = 1 Or Mid
(Trim(mxMiles), 2, 1) <> 0 Or Mid(Trim(mxMiles), 3, 1) <>
0 Then
If Val(Mid(Trim(mxMiles), 2, 2)) < 30
Then
mxCantidad = ArrmxC(Mid(Trim
(mxMiles), 1, 1)) & "TO " & ArrmxU(Mid(Trim(mxMiles), 2,
2))
ElseIf Val(Mid(Trim(mxMiles), 2, 2)) >
29 Then
If Mid(Trim(mxMiles), 3, 1) = 0 Then
mxCantidad = ArrmxC(Mid(Trim
(mxMiles), 1, 1)) & "TO " & ArrmxD(Mid(Trim(mxMiles), 2,
1))
ElseIf Mid(Trim(mxMiles), 3, 1) >=
1 Then
mxCantidad = ArrmxC(Mid(Trim
(mxMiles), 1, 1)) & "TO " & ArrmxD(Mid(Trim(mxMiles), 2,
1)) & " Y " & ArrmxU(Mid(Trim(mxMiles), 3, 1))
End If
End If
End If
Else
If Mid(Trim(mxMiles), 2, 1) = 0 And Mid
(Trim(mxMiles), 3, 1) = 0 Then
mxCantidad = ArrmxC(Mid(Trim(mxMiles),
1, 1))
ElseIf Val(Mid(Trim(mxMiles), 2, 2)) < 30
Then
mxCantidad = ArrmxC(Mid(Trim(mxMiles),
1, 1)) & " " & ArrmxU(Mid(Trim(mxMiles), 2, 2))
ElseIf Val(Mid(Trim(mxMiles), 2, 2)) > 29
Then
If Mid(Trim(mxMiles), 3, 1) = 0 Then
mxCantidad = ArrmxC(Mid(Trim
(mxMiles), 1, 1)) & " " & ArrmxD(Mid(Trim(mxMiles), 2, 1))
ElseIf Mid(Trim(mxMiles), 3, 1) >= 1
Then
mxCantidad = ArrmxC(Mid(Trim
(mxMiles), 1, 1)) & " " & ArrmxD(Mid(Trim(mxMiles), 2, 1))
& " Y " & ArrmxU(Mid(Trim(mxMiles), 3, 1))
End If
End If
End If
End Select
If mxMiles = 1 Then
NumToLetra = NumToLetra & mxCantidad & " MIL "
ElseIf mxMiles > 1 Then
NumToLetra = NumToLetra & mxCantidad & " MIL "
End If
End If

If mxUnids > 0 Then
Select Case Len(Trim(mxUnids))
Case Is = 1
mxCantidad = ArrmxU(mxUnids)
If mxUnids = 1 Then
mxMoneda = "Peso"
End If
Case Is = 2
If Mid(Trim(mxUnids), 1, 1) < 3 Then
mxCantidad = ArrmxU(mxUnids)
ElseIf Mid(Trim(mxUnids), 1, 1) >= 3 Then
If Mid(Trim(mxUnids), 2, 1) = 0 Then
mxCantidad = ArrmxD(Mid(Trim(mxUnids),
1, 1))
ElseIf Mid(Trim(mxUnids), 2, 1) >= 1 Then
mxCantidad = ArrmxD(Mid(Trim(mxUnids),
1, 1)) & " Y " & ArrmxU(Mid(Trim(mxUnids), 2, 1))
End If
End If
Case Is = 3
If Mid(Trim(mxUnids), 1, 1) = 1 Then
If Mid(Trim(mxUnids), 1, 1) = 1 And Mid
(Trim(mxUnids), 2, 1) = 0 And Mid(Trim(mxUnids), 3, 1) = 0
Then
mxCantidad = ArrmxC(Mid(Trim(mxUnids),
1, 1))
ElseIf Mid(Trim(mxUnids), 1, 1) = 1 Or Mid
(Trim(mxUnids), 2, 1) <> 0 Or Mid(Trim(mxUnids), 3, 1) <>
0 Then
If Val(Mid(Trim(mxUnids), 2, 2)) < 30
Then
mxCantidad = ArrmxC(Mid(Trim
(mxUnids), 1, 1)) & "TO " & ArrmxU(Mid(Trim(mxUnids), 2,
2))
ElseIf Val(Mid(Trim(mxUnids), 2, 2)) >
29 Then
If Mid(Trim(mxUnids), 3, 1) = 0 Then
mxCantidad = ArrmxC(Mid(Trim
(mxUnids), 1, 1)) & "TO " & ArrmxD(Mid(Trim(mxUnids), 2,
1))
ElseIf Mid(Trim(mxUnids), 3, 1) >=
1 Then
mxCantidad = ArrmxC(Mid(Trim
(mxUnids), 1, 1)) & "TO " & ArrmxD(Mid(Trim(mxUnids), 2,
1)) & " Y " & ArrmxU(Mid(Trim(mxUnids), 3, 1))
End If
End If
End If
Else
If Mid(Trim(mxUnids), 2, 1) = 0 And Mid
(Trim(mxUnids), 3, 1) = 0 Then
mxCantidad = ArrmxC(Mid(Trim(mxUnids),
1, 1))
ElseIf Val(Mid(Trim(mxUnids), 2, 2)) < 30
Then
mxCantidad = ArrmxC(Mid(Trim(mxUnids),
1, 1)) & " " & ArrmxU(Mid(Trim(mxUnids), 2, 2))
ElseIf Val(Mid(Trim(mxUnids), 2, 2)) > 29
Then
If Mid(Trim(mxUnids), 3, 1) = 0 Then
mxCantidad = ArrmxC(Mid(Trim
(mxUnids), 1, 1)) & " " & ArrmxD(Mid(Trim(mxUnids), 2, 1))
ElseIf Mid(Trim(mxUnids), 3, 1) >= 1
Then
mxCantidad = ArrmxC(Mid(Trim
(mxUnids), 1, 1)) & " " & ArrmxD(Mid(Trim(mxUnids), 2, 1))
& " Y " & ArrmxU(Mid(Trim(mxUnids), 3, 1))
End If
End If
End If
End Select
If mxUnids = 1 Then
NumToLetra = NumToLetra & mxCantidad ' & " MIL "
ElseIf mxUnids > 1 Then
NumToLetra = NumToLetra & mxCantidad ' & " MIL "
End If
End If

If mxCents > 0 Then
NumToLetra = UCase(NumToLetra & " " & mxMoneda
& " " & mxCents & "/100 M.N.")
ElseIf mxCents <= 0 Then
NumToLetra = UCase(NumToLetra & " " & mxMoneda
& " " & "00/100 M.N.")
End If
End Function










hola
quiero convetir una cantidad numerica en letra, 12.50=


doce pesos cincuenta
centavos, las cantidades varian

Saludos
.

Preguntas similares