Ver Mensaje Individual
  #2 (permalink)  
Antiguo 13/10/2008, 21:37
Avatar de jc_moty
jc_moty
 
Fecha de Ingreso: septiembre-2005
Ubicación: Usulután, El Salvador
Mensajes: 477
Antigüedad: 18 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