Como convertir números en letras ... Complemento

¿Podrás complementar el código " Como convertir números en letras" - con números decimales y moneda en Pesos?
Para efectos de recibos
México

1 respuesta

Respuesta
1
Dime el nombre de los textbox y el máximo numero permitido
Gracias
Quisiera poder facturar hasta 10 millones de pesos
10'000,000.00
Diez millones de pesos 00/100 M.N. ( ojalá se pueda agregar MN al final "
El textbox puede ser cualquiera, tú márcalo
Gracias
agrazdi
Ok,
Dame un par de días, que tengo un código para máximo 99,999.99 y debería alargarlo un poco más.
Bien,
El código que te pongo lo que hace es coger el valor de un textbox llamado numero y lo pone en letras en un textbox llamado Texto. Con lo que en donde tengas puesto el valor en numero cambiale el nombre y lo mismo en el textbox destino.
En el procedimiento del evento "al perder enfoque" del textbox numero, dile que genere codigo, y entre el Private Sub y End Sub ponle esto:
Dim dM, M, cmil, dmil, mil, cen, dec, un, udec, ucen As Double
Dim total As Double
Texto.Value = ""
dM = 0
M = 0
cmil = 0
dmil = 0
mil = 0
cen = 0
dec = 0
un = 0
udec = 0
ucen = 0
total = Numero.Value
Do Until total < 10000000
    dM = dM + 1
    total = total - 10000000
Loop
Do Until total < 1000000
    M = M + 1
    total = total - 1000000
Loop
Do Until total < 100000
    cmil = cmil + 1
    total = total - 100000
Loop
Do Until total < 10000
    dmil = dmil + 1
    total = total - 10000
Loop
Do Until total < 1000
    mil = mil + 1
    total = total - 1000
Loop
Do Until total < 100
    cen = cen + 1
    total = total - 100
Loop
Do Until total < 10
    dec = dec + 1
    total = total - 10
Loop
Do Until total < 1
    un = un + 1
    total = total - 1
Loop
Do Until total < 0.1
    udec = udec + 1
    total = total - 0.1
Loop
Do Until total < 0.009
    ucen = ucen + 1
    total = total - 0.01
Loop
total = dM * 10 + M
If dM > 0 Then
    nombredecena (total)
Else
    If M > 0 Then
        Texto = Texto & " "
        nombreunidad (M)
    End If
End If
If total > 0 Then
    If total > 1 Then
        Texto = Texto & " millones"
    Else
        Texto = Texto & " millon"
    End If
End If
If cmil > 1 Then
    If cmil = 5 Then
        Texto = Texto & " quinientos"
    Else
        Texto = Texto & " "
        If cmil = 7 Or cmil = 9 Then
            nombreunidad (cmil * 100)
        Else
            nombreunidad (cmil)
        End If
        Texto = Texto & "cientos"
    End If
Else
    If cmil = 1 Then
        If dmil > 0 Or mil > 0 Then
            Texto = Texto & " ciento"
        Else
            Texto = Texto & " cien"
        End If
    End If
End If
If dmil > 0 Then
    total = dmil * 10 + mil
    nombredecena (total)
    If mil = 1 Then
        Texto = Left(Texto, Len(Texto) - 1)
    End If
Else
    If mil > 1 Then
        nombreunidad (mil)
    End If
End If
If mil > 0 Or dmil > 0 Then
    Texto = Texto & " mil"
End If
If cen > 1 Then
    If cen = 5 Then
        Texto = Texto & " quinientos"
    Else
        Texto = Texto & " "
        If cen = 7 Or cen = 9 Then
            nombreunidad (cen * 100)
        Else
            nombreunidad (cen)
        End If
        Texto = Texto & "cientos"
    End If
Else
    If cen = 1 Then
        If dec > 0 Or un > 0 Then
            Texto = Texto & " ciento"
        Else
            Texto = Texto & " cien"
        End If
    End If
End If
If dec > 0 Then
    total = dec * 10 + un
    nombredecena (total)
Else
    If un > 0 Then
        Texto = Texto & " "
        nombreunidad (un)
    End If
End If
If udec > 0 Or ucen > 0 Then
    Texto = Texto & " con"
    If udec > 0 Then
        total = udec * 10 + ucen
        nombredecena (total)
    Else
        If ucen > 0 Then
            nombreunidad (ucen)
        End If
    End If
End If
Texto = Right(Texto, Len(Texto) - 1) & " MN"
----------------------------------------------------------------------------------------------
Y miras el codigo y debajo de donde pone "Option Compare Database" le pegas lo siguiente:
Sub nombreunidad(num As Integer)
Select Case num
    Case 1
        Texto = Texto & "uno"
    Case 2
        Texto = Texto & "dos"
    Case 3
        Texto = Texto & "tres"
    Case 4
        Texto = Texto & "cuatro"
    Case 5
        Texto = Texto & "cinco"
    Case 6
        Texto = Texto & "seis"
    Case 7
        Texto = Texto & "siete"
    Case 8
        Texto = Texto & "ocho"
    Case 9
        Texto = Texto & "nueve"
    Case 700
        Texto = Texto & "sete"
    Case 900
        Texto = Texto & "nove"
End Select
End Sub
Sub nombredecena(num As Integer)
Dim dec, un
dec = 0
un = 0
Do Until num < 10
    dec = dec + 1
    num = num - 10
Loop
Do Until num < 1
    un = un + 1
    num = num - 1
Loop
Select Case dec
    Case 1
        Select Case un
            Case 0
                Texto = Texto & " diez"
            Case 1
                Texto = Texto & " once"
            Case 2
                Texto = Texto & " doce"
            Case 3
                Texto = Texto & " trece"
            Case 4
                Texto = Texto & " catorce"
            Case 5
                Texto = Texto & " quince"
            Case 6
                Texto = Texto & " dieciseis"
            Case 7
                Texto = Texto & " diecisiete"
            Case 8
                Texto = Texto & " dieciocho"
            Case 9
                Texto = Texto & " diecinueve"
        End Select
    Case 2
        Texto = Texto & " veint"
        If un = 0 Then
            Texto = Texto & "e"
        Else
            Texto = Texto & "i"
        End If
    Case 3
        Texto = Texto & " treinta"
    Case 4
        Texto = Texto & " cuarenta"
    Case 5
        Texto = Texto & " cincuenta"
    Case 6
        Texto = Texto & " sesenta"
    Case 7
        Texto = Texto & " setenta"
    Case 8
        Texto = Texto & " ochenta"
    Case 9
        Texto = Texto & " noventa"
End Select
If dec > 2 And un > 0 Then
    Texto = Texto & " y "
End If
If dec > 1 And un > 0 Then
    nombreunidad (un)
End If
End Sub
Gracias
Me sirve mucho.
Cuando tengas oportunidad de agregarle centavos y nombre de la moneda quedaría de lujo
Gracias
agrazdi

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas