furmula para Acces
Alguien sabe alguna funcion para convertir un numero por ejemplo 123 a ciento veintitres tambien con decimales ...
AGREGA ESTE MODULO Y LO LLAMAS ON FORMAT DEL REPORTE QUE QUIERAS QUE APAREZCA,, HAZ LAS ADECUACIONES, SALU2:
'Funciones para convertir de números a letras
'Llamada : Letras(Número,Formato) - Formato 1-Pesos, 2-Dólares
Function Unidades(num, UNO)
Dim U
Dim CAD
U = Array("Un", "Dos", "Tres", "Cuatro", "Cinco", "Seis", "Siete", "Ocho", "Nueve")
CAD = ""
If num = 1 Then
If UNO = 1 Then
CAD = CAD & "uno"
Else
CAD = CAD & "un"
End If
Else
CAD = CAD & U(num - 1)
End If
Unidades = CAD
End Function
Function Decenas(num1, res)
Dim D1
Dim D2
Dim CAD
Dim CAD1
D1 = Array("Once", "Doce", "Trece", "Catorce", "Quince", "Dieciseis", "Diescisiete", _
"Dieciocho", "Diecinueve")
D2 = Array("Diez", "Veinte", "Treinta", "Cuarenta", "Cincuenta", "Sesenta", _
"Setenta", "Ochenta", "Noventa")
If num1 > 10 And num1 < 20 Then
CAD1 = D1(num1 - 10 - 1)
Else
CAD1 = D2((num1 10) - 1)
If (num1 10) <> 2 Then
If res > 0 Then
CAD1 = CAD1 & " y "
CAD1 = CAD1 & Unidades(num1 Mod 10, 0)
End If
Else
If res = 0 Then
CAD1 = CAD1 & " "
Else
CAD1 = CAD1 & " y "
CAD1 = CAD1 & Unidades(num1 Mod 10, 0)
End If
End If
End If
Decenas = CAD1
End Function
Function Cientos(num2)
Dim NUM3
Dim CAD2
NUM3 = num2 100
Select Case NUM3
Case 1
If num2 = 100 Then
CAD2 = "Cien "
Else
CAD2 = "Ciento "
End If
Case 5
CAD2 = "Quinientos "
Case 7
CAD2 = "Setecientos "
Case 9
CAD2 = "Novecientos "
Case Else
CAD2 = Unidades(NUM3, 0) & "cientos "
End Select
num2 = num2 Mod 100
If num2 > 0 Then
If num2 < 10 Then
CAD2 = CAD2 & Unidades(num2, num2)
Else
CAD2 = CAD2 & Decenas(num2, num2 Mod 10)
End If
End If
Cientos = CAD2
End Function
Function Miles(num4)
Dim CAD3
If (num4 >= 100) Then
CAD3 = Cientos(num4)
Else
If (num4 >= 10) Then
CAD3 = Decenas(num4, num4 Mod 10)
Else
CAD3 = Unidades(num4, 0)
End If
End If
CAD3 = CAD3 & " mil "
Miles = CAD3
End Function
Function Millones(cant)
Dim TER
Dim CANTL
If cant = 1 Then
TER = " "
Else
TER = "es "
End If
If (cant >= 1000) Then
CANTL = CANTL & Miles(cant 1000)
cant = cant Mod 1000
End If
If cant > 0 Then
If cant >= 100 Then
CANTL = CANTL & Cientos(cant)
Else
If cant >= 10 Then
CANTL = CANTL & Decenas(cant, cant Mod 10)
Else
CANTL = CANTL & Unidades(cant, 0)
End If
End If
End If
Millones = CANTL & " Millon" & TER
End Function
'Function decimales(numero As Single) As Integer
'Dim iaux As Integer
'iaux = numero - Application.Round(numero, 2)
'decimales = iaux
'End Function
Function Letras(cantm As Variant, ByVal mon As Integer) As String
Dim cants1 As String, num1 As Variant, num2 As Variant
Dim CENTS
Dim CENTS1
Dim CANTLM
num1 = cantm 1000000
num2 = cantm - (num1 * 1000000)
CENTS = (num2 * 100) Mod 100
If CENTS = 0 Then
CENTS1 = "00"
Else
CENTS1 = FORMAT(CENTS)
End If
cantm = cantm - (CENTS / 100)
If cantm >= 1000000 Then
CANTLM = Millones(cantm 1000000)
cantm = cantm Mod 1000000
End If
If cantm > 0 Then
If (cantm >= 1000) Then
CANTLM = CANTLM & Miles(cantm 1000)
cantm = cantm Mod 1000
End If
End If
If cantm > 0 Then
If cantm >= 100 Then
CANTLM = CANTLM & Cientos(cantm)
Else
If cantm >= 10 Then
CANTLM = CANTLM & Decenas(cantm, cantm Mod 10)
Else
CANTLM = CANTLM & Unidades(cantm, 1)
End If
End If
End If
If mon = 1 Then
Letras = "*** Son " & CANTLM & " " & Reports![Facturacion]![Moneda] & " " & CENTS1 & "/100 " & " ***"
Else
Letras = "*** Son " & CANTLM & " " & Reports![Facturacion]![Moneda] & " " & CENTS1 & "/100 " & " ***"
End If
End Function
Sub CalcularFacturas()
Dim res As String, num As Single
'num = 50899697.51
'res = letras(num, 1)
'num = 25000
num = Reports![Facturacion]![TOTAL]
res = Letras(num, 1)
Reports![Facturacion]![CantLetras] = res
End Sub
Sub CalcularCotizaciones()
Dim res As String, num As Single
'num = 50899697.51
'res = letras(num, 1)
'num = 2750
num = Reports![Cotizacion]![TotalP]
res = Letras(num, 1)
Reports![Cotizacion]![CantLetras] = res
End Sub
Sub Calcular1()
Dim res As String, num As Single
'num = 50899697.51
'res = letras(num, 1)
'num = 25000
num = Reports![Polizas]![PAGO]
res = Letras(num, 1)
Reports![FacturarA]![Letras] = res
End Sub
'Funciones para convertir de números a letras
'Llamada : Letras(Número,Formato) - Formato 1-Pesos, 2-Dólares
Function Unidades(num, UNO)
Dim U
Dim CAD
U = Array("Un", "Dos", "Tres", "Cuatro", "Cinco", "Seis", "Siete", "Ocho", "Nueve")
CAD = ""
If num = 1 Then
If UNO = 1 Then
CAD = CAD & "uno"
Else
CAD = CAD & "un"
End If
Else
CAD = CAD & U(num - 1)
End If
Unidades = CAD
End Function
Function Decenas(num1, res)
Dim D1
Dim D2
Dim CAD
Dim CAD1
D1 = Array("Once", "Doce", "Trece", "Catorce", "Quince", "Dieciseis", "Diescisiete", _
"Dieciocho", "Diecinueve")
D2 = Array("Diez", "Veinte", "Treinta", "Cuarenta", "Cincuenta", "Sesenta", _
"Setenta", "Ochenta", "Noventa")
If num1 > 10 And num1 < 20 Then
CAD1 = D1(num1 - 10 - 1)
Else
CAD1 = D2((num1 10) - 1)
If (num1 10) <> 2 Then
If res > 0 Then
CAD1 = CAD1 & " y "
CAD1 = CAD1 & Unidades(num1 Mod 10, 0)
End If
Else
If res = 0 Then
CAD1 = CAD1 & " "
Else
CAD1 = CAD1 & " y "
CAD1 = CAD1 & Unidades(num1 Mod 10, 0)
End If
End If
End If
Decenas = CAD1
End Function
Function Cientos(num2)
Dim NUM3
Dim CAD2
NUM3 = num2 100
Select Case NUM3
Case 1
If num2 = 100 Then
CAD2 = "Cien "
Else
CAD2 = "Ciento "
End If
Case 5
CAD2 = "Quinientos "
Case 7
CAD2 = "Setecientos "
Case 9
CAD2 = "Novecientos "
Case Else
CAD2 = Unidades(NUM3, 0) & "cientos "
End Select
num2 = num2 Mod 100
If num2 > 0 Then
If num2 < 10 Then
CAD2 = CAD2 & Unidades(num2, num2)
Else
CAD2 = CAD2 & Decenas(num2, num2 Mod 10)
End If
End If
Cientos = CAD2
End Function
Function Miles(num4)
Dim CAD3
If (num4 >= 100) Then
CAD3 = Cientos(num4)
Else
If (num4 >= 10) Then
CAD3 = Decenas(num4, num4 Mod 10)
Else
CAD3 = Unidades(num4, 0)
End If
End If
CAD3 = CAD3 & " mil "
Miles = CAD3
End Function
Function Millones(cant)
Dim TER
Dim CANTL
If cant = 1 Then
TER = " "
Else
TER = "es "
End If
If (cant >= 1000) Then
CANTL = CANTL & Miles(cant 1000)
cant = cant Mod 1000
End If
If cant > 0 Then
If cant >= 100 Then
CANTL = CANTL & Cientos(cant)
Else
If cant >= 10 Then
CANTL = CANTL & Decenas(cant, cant Mod 10)
Else
CANTL = CANTL & Unidades(cant, 0)
End If
End If
End If
Millones = CANTL & " Millon" & TER
End Function
'Function decimales(numero As Single) As Integer
'Dim iaux As Integer
'iaux = numero - Application.Round(numero, 2)
'decimales = iaux
'End Function
Function Letras(cantm As Variant, ByVal mon As Integer) As String
Dim cants1 As String, num1 As Variant, num2 As Variant
Dim CENTS
Dim CENTS1
Dim CANTLM
num1 = cantm 1000000
num2 = cantm - (num1 * 1000000)
CENTS = (num2 * 100) Mod 100
If CENTS = 0 Then
CENTS1 = "00"
Else
CENTS1 = FORMAT(CENTS)
End If
cantm = cantm - (CENTS / 100)
If cantm >= 1000000 Then
CANTLM = Millones(cantm 1000000)
cantm = cantm Mod 1000000
End If
If cantm > 0 Then
If (cantm >= 1000) Then
CANTLM = CANTLM & Miles(cantm 1000)
cantm = cantm Mod 1000
End If
End If
If cantm > 0 Then
If cantm >= 100 Then
CANTLM = CANTLM & Cientos(cantm)
Else
If cantm >= 10 Then
CANTLM = CANTLM & Decenas(cantm, cantm Mod 10)
Else
CANTLM = CANTLM & Unidades(cantm, 1)
End If
End If
End If
If mon = 1 Then
Letras = "*** Son " & CANTLM & " " & Reports![Facturacion]![Moneda] & " " & CENTS1 & "/100 " & " ***"
Else
Letras = "*** Son " & CANTLM & " " & Reports![Facturacion]![Moneda] & " " & CENTS1 & "/100 " & " ***"
End If
End Function
Sub CalcularFacturas()
Dim res As String, num As Single
'num = 50899697.51
'res = letras(num, 1)
'num = 25000
num = Reports![Facturacion]![TOTAL]
res = Letras(num, 1)
Reports![Facturacion]![CantLetras] = res
End Sub
Sub CalcularCotizaciones()
Dim res As String, num As Single
'num = 50899697.51
'res = letras(num, 1)
'num = 2750
num = Reports![Cotizacion]![TotalP]
res = Letras(num, 1)
Reports![Cotizacion]![CantLetras] = res
End Sub
Sub Calcular1()
Dim res As String, num As Single
'num = 50899697.51
'res = letras(num, 1)
'num = 25000
num = Reports![Polizas]![PAGO]
res = Letras(num, 1)
Reports![FacturarA]![Letras] = res
End Sub