Caz
21 de Mayo del 2004

Saludos., quien tendrá una Rutina para transformar numeros a Letras, pero con Crystal report. Gracias....

o Con VB6...
Caz..!

Meifer
21 de Mayo del 2004

Con visual basic

Public Function NumLetras(ByVal Numero As Double, ByVal Estilo As Integer, Optional bValor As Boolean = False) As String
Dim NumTmp As String, c01 As Integer, c02 As Integer, pos As Integer, dig As Integer
Dim cen As Integer, dec As Integer, uni As Integer, letra1 As String, letra2 As String
Dim letra3 As String, Leyenda As String, Leyenda1 As String, TFNumero 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 digito 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)

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 Val(NumTmp) = 0 Or Val(NumTmp) < 1 Then
Leyenda1 = "Cero Bolivares "
ElseIf Val(NumTmp) = 1 Or Val(NumTmp) < 2 Then
Leyenda1 = "Bolivar "
ElseIf Val(Mid(NumTmp, 4, 12)) = 0 Or Val(Mid(NumTmp, 10, 6)) = 0 Then
Leyenda1 = "de Bolivares "
Else
Leyenda1 = "Bolivares "
End If

TFNumero = TFNumero & Leyenda1 & " con "
Select Case Estilo
Case 1: TFNumero = StrConv(TFNumero, vbUpperCase)
Case 2: TFNumero = StrConv(TFNumero, vbLowerCase)
Case Else: TFNumero = StrConv(TFNumero, vbProperCase)
End Select

TFNumero = TFNumero & Mid(NumTmp, 17) & "/100 "
If bValor Then TFNumero = TFNumero & "(Bs. " & FormatNumber(Numero, 2) & ")"
NumLetras = TFNumero

End Function

'//Centena de la function numletra
Private Function Centena(ByVal uni As Integer, ByVal dec As Integer, ByVal cen As Integer) As String
Dim vCentena As Variant

vCentena = Array("cien ", "ciento ", "doscientos ", "trescientos ", "cuatrocientos ", "quinientos ", "seiscientos ", "setecientos ", "ochocientos ", "novecientos ")
Select Case cen
Case 1: If dec + uni = 0 Then Centena = vCentena(0) Else Centena = vCentena(1)
Case 2, 3, 4, 5, 6, 7, 8, 9: Centena = vCentena(cen)
Case Else: Centena = ""
End Select
End Function


'//Decena de la function numletra
Private Function Decena(ByVal uni As Integer, ByVal dec As Integer) As String
Dim vNivel1 As Variant, vNivel2 As Variant

vNivel1 = Array("diez ", "once ", "doce ", "trece ", "catorce ", "quince ", "dieci")
vNivel2 = Array("", "", "", "treinta ", "cuarenta ", "cincuenta ", "sesenta ", "setenta ", "ochenta ", "noventa ")
Select Case dec
Case 1: If uni <= 5 Then Decena = vNivel1(uni) Else Decena = vNivel1(6)
Case 2: If uni = 0 Then Decena = "veinte " Else Decena = "veinti"
Case 3, 4, 5, 6, 7, 8, 9: Decena = vNivel2(dec)
Case Else: Decena = ""
End Select

If uni > 0 And dec > 2 Then Decena = Decena + "y "
End Function


'//Unidad de la function numletra
Public Function Unidad(ByVal uni As Integer, ByVal dec As Integer) As String
Dim vUnidad As Variant
vUnidad = Array("", "un ", "dos ", "tres ", "cuatro ", "cinco ", "seis ", "siete ", "ocho ", "nueve ")
If dec <> 1 Then
Select Case uni: Case 1, 2, 3, 4, 5: Unidad = vUnidad(uni): End Select
End If
Select Case uni: Case 6, 7, 8, 9: Unidad = vUnidad(uni): End Select
End Function