Como Convertir Precio A Letras En Access Cuando Aparece S/1062 En Letras Que Aparezca mil sesenta y dos 00/100

Como Convertir Precio A Letras En Access Cuando Aparece S/1062 En Letras Que Aparezca mil sesenta y dos 00/100 por favor lo necesito urgente tengo un codigo tal vez ay que modificarlo este es parte de mencionado codigo

Option Compare Database
Option Explicit
Function letra(Numero)
Dim texto
Dim Millones
Dim Miles
Dim Cientos
Dim decimales
Dim Cadena
Dim CadMillones
Dim CadMiles
Dim CadCientos
Dim caddecimales
texto = Round(Numero, 2)
texto = FormatNumber(texto, 2)
texto = Right(Space(14) & texto, 14)
Millones = Mid(texto, 1, 3)
Miles = Mid(texto, 5, 3)
Cientos = Mid(texto, 9, 3)
decimales = Mid(texto, 13, 2)
CadMillones = ConvierteCifra(Millones, False)
CadMiles = ConvierteCifra(Miles, False)
CadCientos = ConvierteCifra(Cientos, True)
caddecimales = ConvierteDecimal(decimales)

If Trim(CadMillones) > "" Then
If Trim(CadMillones) = "Un" Then
Cadena = CadMillones & " Millón"
Else
Cadena = CadMillones & " Millones"
End If
End If

If Trim(CadMiles) > "" Then
If Trim(CadMiles) = "Un" Then
CadMiles = ""
Cadena = Cadena & "" & CadMiles & "Mil"
CadMiles = "Un"
Else
Cadena = Cadena & " " & CadMiles & " Mil"
End If
End If
If Trim(CadMiles) > "001" Then
CadMiles = "Mil"
End If

If decimales = "00" Then
If Trim(CadMillones & CadMiles & CadCientos & caddecimales) = "Un" Then
Cadena = Cadena & "Uno "
Else
If Miles & Cientos = "000000" Then
Cadena = Cadena & " " & Trim(CadCientos)
Else
Cadena = Cadena & " " & Trim(CadCientos)
End If
letra = Trim(Cadena)
End If
Else
If Trim(CadMillones & CadMiles & CadCientos & caddecimales) = "Un" Then
Cadena = Cadena & "Uno " & "Con " & Trim(caddecimales)
Else
If Millones & Miles & Cientos & decimales = "000000" Then
Cadena = Cadena & " " & Trim(CadCientos) & " " & Trim(decimales) & "/100 Nuevos Soles"
'Cadena = Cadena & " " & Trim(CadCientos) & " PESOS " & Trim(Decimales) & "/100 M.N."
Else
Cadena = Cadena & " " & Trim(CadCientos) & " " & Trim(decimales) & "/100 Nuevos Soles"
'Cadena = Cadena & " " & Trim(CadCientos) & " PESOS " & Trim(Decimales) & "/100 M.N."
End If
letra = Trim(Cadena)
End If
End If

End Function

1 respuesta

Respuesta

Hay funciones mucho más completas en la Web que manejan cantidades más grandes, búscalas.

He buscado por toda la web y no encuentro alguna solución por favor si hay alguna ayuda

Public Function NumLetras(ByVal Numero As Double, ByVal Mayusculas As Integer) As String
    Dim NumTmp As String
    Dim c01 As Integer
    Dim c02 As Integer
    Dim pos As Integer
    Dim dig As Integer
    Dim cen As Integer
    Dim dec As Integer
    Dim uni As Integer
    Dim letra1 As String
    Dim letra2 As String
    Dim letra3 As String
    Dim Leyenda As String
    Dim Leyenda1 As String
    Dim TFNumero As String
    Dim strSQl As String
    Dim Moneda1 As String
    Dim Moneda2 As String
    Moneda1 = "Pesos"    ' Valores por Defecto. Puedes cambiarlo por Sucres, Soles etc
    Moneda2 = "Pesos"    ' Valores por Defecto, Puedes cambiarlo por Sucres, Soles etc
    If Numero < 0 Then Numero = Abs(Numero)
    NumTmp = Format(Numero, "000000000000000.00")        'Le da un formato fijo
    c01 = 1
    pos = 1
    TFNumero = ""
    Do While c01 <= 5
        c02 = 1
        Do While c02 <= 3
            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, cen)
        letra1 = Unidad(uni, dec, cen)
        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 " & Moneda2 & " "
    ElseIf Val(NumTmp) = 1 Or Val(NumTmp) < 2 Then
        Leyenda1 = Moneda1 & " "
    ElseIf Val(mid(NumTmp, 4, 12)) = 0 Or Val(mid(NumTmp, 10, 6)) = 0 Then
        Leyenda1 = "de " & Moneda2 & " "
    Else
        Leyenda1 = Moneda2 & " "
    End If
    TFNumero = TFNumero & Leyenda1 & mid(NumTmp, 17) & "/100 M/CTE"
    Select Case Mayusculas
    Case 1
        TFNumero = StrConv(TFNumero, vbUpperCase)
    Case 2
        TFNumero = StrConv(TFNumero, vbLowerCase)
    Case 3
        TFNumero = StrConv(TFNumero, vbProperCase)
    End Select
   ' NumLetras = TFNumero
    NumLetras = "****" & TFNumero & "****"
End Function
Private Function Centena(ByVal uni As Integer, ByVal dec As Integer, _
                         ByVal cen As Integer) As String
    Dim cTexto As String
    Select Case cen
    Case 1
        If dec + uni = 0 Then
            cTexto = "cien "
        Else
            cTexto = "ciento "
        End If
    Case 2: cTexto = "doscientos "
    Case 3: cTexto = "trescientos "
    Case 4: cTexto = "cuatrocientos "
    Case 5: cTexto = "quinientos "
    Case 6: cTexto = "seiscientos "
    Case 7: cTexto = "setecientos "
    Case 8: cTexto = "ochocientos "
    Case 9: cTexto = "novecientos "
    Case Else: cTexto = ""
    End Select
    Centena = cTexto
End Function
Private Function Decena(ByVal uni As Integer, ByVal dec As Integer, _
                        ByVal cen As Integer) As String
    Dim cTexto As String
    Select Case dec
    Case 1:
        Select Case uni
        Case 0: cTexto = "diez "
        Case 1: cTexto = "once "
        Case 2: cTexto = "doce "
        Case 3: cTexto = "trece "
        Case 4: cTexto = "catorce "
        Case 5: cTexto = "quince "
        Case 6 To 9: cTexto = "dieci"
        End Select
    Case 2:
        If uni = 0 Then
            cTexto = "veinte "
        ElseIf uni > 0 Then
            cTexto = "veinti"
        End If
    Case 3: cTexto = "treinta "
    Case 4: cTexto = "cuarenta "
    Case 5: cTexto = "cincuenta "
    Case 6: cTexto = "sesenta "
    Case 7: cTexto = "setenta "
    Case 8: cTexto = "ochenta "
    Case 9: cTexto = "noventa "
    Case Else: cTexto = ""
    End Select
    If uni > 0 And dec > 2 Then cTexto = cTexto + "y "
    Decena = cTexto
End Function
Private Function Unidad(ByVal uni As Integer, ByVal dec As Integer, _
                        ByVal cen As Integer) As String
    Dim cTexto As String
    If dec <> 1 Then
        Select Case uni
        Case 1: cTexto = "un "
        Case 2: cTexto = "dos "
        Case 3: cTexto = "tres "
        Case 4: cTexto = "cuatro "
        Case 5: cTexto = "cinco "
        End Select
    End If
    Select Case uni
    Case 6: cTexto = "seis "
    Case 7: cTexto = "siete "
    Case 8: cTexto = "ocho "
    Case 9: cTexto = "nueve "
    End Select
    Unidad = cTexto
End Function

MUY BUENO LA FÓRMULA SR eperezfer PERO AL EJECUTAR SALE UN CUADRO QUE DICE INTRODUZCA EL VALOR DEL PARÁMETRO LETRA SI SE Podría Agregar Algún Código Gracias y disculpe la molestia

Haber te explico. El código que de la respuesta contiene 3 funciones, las cuales debes guardarlas en un módulo de VBA, después la puedas llamar desde cualquier parte asi:

NumLetras(1026.55,1), en donde 1026.55 es el número de a convertir el 1 indica que devuelva las letras en mayúsculas, si es 2 devuelve en minúsculas, y, 3 devuelve la primera letra de cada palabra en mayúsculas y las demás en minúsculas.

Que pena se me olvidó explicarte la llamada a la función.

Perdón son 4 funciones. La primera es la principal por tal se declara pública.

GRACIAS AMIGO POR TU PACIENCIA Lo que yo tengo es un informe y en ese informe esta mi Facturación, y esta compuesta de lo siguiente un cuadro de texto para suma de precios otro cuadro de texto para igv otro cuadro de texto para total a pagar y un cuadro de texto final que hace referencia al texto pago total para que aparezca letra por precio como lo haría por favor ayúdeme

Si probaste al función que te envíe solo hace falta hacer referencia a la función en el campo de texto del informe. Supongamos que el cuadro de texto se llama txtFinal y que el campo que contiene el valor numérico se llama ctlTotal, en este caso quedaría algo como:

En el campo txtFinal vas a propiedades y en origen del control colocas =NumLetra([ctlTotal,1)

En la pestaña datos en Bloqueado coloca Sí.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas