
13/10/2008, 21:37
|
 | | | Fecha de Ingreso: septiembre-2005 Ubicación: Usulután, El Salvador
Mensajes: 477
Antigüedad: 19 años, 6 meses Puntos: 1 | |
Respuesta: Convertir numero a letras con vb6.0 Aqui esta el codigo de ASP traducido a VB 6.0:
Código:
Dim xcen(9) 'centenas
Dim xdec(9) 'decenas
Dim xuni(9) 'unidades
Dim xexc(6) 'except
Dim ceros(9)
Function CONVERTIR(pnumero As Double) As String
Dim letras
Dim i
Dim c
Dim j
Dim xnumero
Dim xnum
Dim num
Dim digito
Dim numero_ent
Dim entero
Dim decimales
Dim temp
xcen(2) = "Dosc"
xcen(3) = "Tresc"
xcen(4) = "Cuatrosc"
xcen(5) = "Quin"
xcen(6) = "Seisc"
xcen(7) = "Setec"
xcen(8) = "Ochoc"
xcen(9) = "Novec"
xdec(2) = "Veinti"
xdec(3) = "Trei"
xdec(4) = "Cuare"
xdec(5) = "Cincue"
xdec(6) = "Sese"
xdec(7) = "Sete"
xdec(8) = "Oche"
xdec(9) = "Nove"
xuni(1) = "Uno"
xuni(2) = "Dos"
xuni(3) = "Tres"
xuni(4) = "Cuatro"
xuni(5) = "Cinco"
xuni(6) = "Seis"
xuni(7) = "Siete"
xuni(8) = "Ocho"
xuni(9) = "Nueve"
xexc(1) = "Diez"
xexc(2) = "Once"
xexc(3) = "Doce"
xexc(4) = "Trece"
xexc(5) = "Catorce"
xexc(6) = "Quince"
ceros(1) = "0"
ceros(2) = "00"
ceros(3) = "000"
ceros(4) = "0000"
ceros(5) = "00000"
ceros(6) = "000000"
ceros(7) = "0000000"
ceros(8) = "00000000"
c = 1
i = 1
j = 0
xnumero = CStr(pnumero)
If CDbl(LTrim(RTrim(pnumero))) < 999999999.99 Then
numero_ent = CDbl(Int(pnumero))
If Len(numero_ent) < 9 Then
numero_ent = ceros(9 - Len(numero_ent)) & numero_ent
End If
entero = CDbl(Int(numero_ent))
decimales = (CDbl(xnumero) - entero) * 100
Do While i < 8
temp = 0
num = CDbl(Mid(numero_ent, i, 3))
xnum = Mid(numero_ent, i, 3)
digito = CDbl(Mid(xnum, 1, 1))
'/* analizo el numero entero de a 3 */
If xnum = "000" Then
j = 0
Else
j = 1
If digito > 1 Then
letras = letras & xcen(digito) & "ientos "
End If
If Mid(xnum, 1, 1) = "1" And Mid(xnum, 2, 2) <> "00" Then
letras = letras & "ciento "
ElseIf Mid(xnum, 1, 1) = "1" Then
letras = letras & "cien "
End If
'/* analisis de las decenas */
digito = CDbl(Mid(xnum, 2, 1))
If digito > 2 And Mid(xnum, 3, 1) = "0" Then
letras = letras & xdec(digito) & "nta "
temp = 1
End If
If digito > 2 And Mid(xnum, 3, 1) <> "0" Then
letras = letras & xdec(digito) & "nta y "
End If
If digito = 2 And Mid(xnum, 3, 1) = "0" Then
letras = letras & "veinte "
temp = 1
ElseIf digito = 2 And Mid(xnum, 3, 1) <> "0" Then
letras = letras & "veinti"
End If
If digito = 1 And Mid(xnum, 3, 1) >= "6" Then
letras = letras & "dieci"
ElseIf digito = 1 And Mid(xnum, 3, 1) < "6" Then
letras = letras & xexc(CDbl(Mid(xnum, 3, 1) + 1))
temp = 1
End If
End If
If temp = 0 Then
'/* analisis del ultimo digito */
digito = CDbl(Mid(xnum, 3, 1))
If ((c = 1) Or (c = 2)) And xnum = "001" Then
letras = letras & "un"
Else
If ((c = 1) Or (c = 2)) And xnum >= "020" And Mid(xnum, 3, 1) = "1" Then
letras = letras & "un"
Else
If digito <> 0 Then
letras = letras & xuni(digito)
End If
End If
End If
End If
If j = 1 And i = 1 And xnum = "001" And c = 1 Then
letras = letras & " millon "
ElseIf j = 1 And i = 1 And xnum <> "001" And c = 1 Then
letras = letras & " millones "
ElseIf j = 1 And i = 4 And c = 2 Then
letras = letras & " mil "
End If
i = i + 3
c = c + 1
Loop
If letras = "" Then
letras = "cero "
End If
If decimales <> 0 Then
decimales = Round(decimales)
letras = "SON: " & letras & " con " & CStr(decimales) & "/100 soles"
Else
letras = "SON: " & letras & " soles"
End If
End If
CONVERTIR = UCase(letras)
End Function
La llamada de la funcion:
Código:
MsgBox CONVERTIR(520920.50)
OjO: Este codigo convierte tambien millones.
Saludos y creditos a NoChance por tan excelente codigo.
Última edición por jc_moty; 13/10/2008 a las 21:51 |