transform a number into letter. Spanish Language only. Visual Basic Code.
Public Function En_letra(VALOR As Variant, Optional xyz As Variant) As String
If IsNull(VALOR) Then Exit Function
'By Alberto Rodriguez Jarabo Research & Co. 2002 ver 1.0.0.0
'estructura de la numeracion:
'millares MIL //centenas//decenas//millones MILLONES // centenas // decenas //millares MIL // centenas//decenas//unidades EUROS
'con //decenas//unidades CENTIMOS DE EUROS
Dim coma As Integer
Dim cadena1 As String
Dim cadena2 As String
Dim cadena_m As String
Dim n_caracteres As Integer
Dim euro As String
Dim longitud As Integer
Dim x As Integer
Dim a As Integer
Dim NuncaNegativoSiemprePositivo As Boolean ' by ex-entrenador del Barsa
' Vamos a meternos con los negativos
NuncaNegativoSiemprePositivo = False
If Len(Trim((VALOR))) > 0 Then
Else
En_letra = ""
Exit Function
End If
If Val(VALOR) < 0 Then
En_letra = "!!!!!! ERROR: NUMERO NEGATIVO ¡¡¡¡¡¡¡¡¡¡"
Exit Function
End If
VALOR = comprueba(CStr(VALOR))
If Len(CStr(VALOR)) > 15 Then
MsgBox "Too Many digits in the String ! ! "
Exit Function
End If
longitud = Len(CStr(VALOR))
coma = InStr(VALOR, ",")
If longitud > 12 Then
longitud = longitud - 3 'saco la len menos los decimales
longitud = longitud - 9 'saco la len menos la cadena1
cadena1 = CStr(CLng(Mid(VALOR, longitud + 1, 9)))
cadena_m = CStr(CLng(Left(VALOR, longitud)))
cadena2 = Right(VALOR, 2)
x = 3
Else
cadena1 = CStr(CLng((Left(VALOR, coma - 1))))
cadena2 = Mid(VALOR, coma + 1)
x = 2
End If
'Euro o Euros
If Len(cadena1) > 1 Then
euro = " Euros "
Else
If cadena1 = 1 Then
euro = " Euro "
Else
euro = " Euros "
End If
End If
'empezamos con cadena1, en funcion de la longitud, llamamos a una función u a otra
For a = 1 To x
If a = 1 Then
n_caracteres = Len(cadena1)
Select Case n_caracteres
Case 1
If cadena1 = 0 Then
cadena1 = "cero"
Else
cadena1 = unidad(CInt(cadena1))
End If
Case 2
cadena1 = decenas(CInt(cadena1))
Case 3
cadena1 = centenas(CInt(cadena1))
Case 4
If Left(cadena1, 1) = 1 Then
cadena1 = " mil " & centenas(Right(cadena1, 3))
Else
cadena1 = unidad(Left(cadena1, 1)) & " mil " & centenas(Right(cadena1, 3))
End If
Case 5
cadena1 = decenas(Left(cadena1, 2)) & " mil " & centenas(Right(cadena1, 3))
Case 6
cadena1 = centenas(Left(cadena1, 3)) & " mil " & centenas(Right(cadena1, 3))
Case 7
If Left(cadena1, 1) = 1 Then
cadena1 = "un millon " & centenas(Mid(cadena1, 2, 3)) & " mil " & centenas(Right(cadena1, 3))
Else
cadena1 = unidad(Left(cadena1, 1)) & " millones " & centenas(Mid(cadena1, 2, 3)) & " mil " & centenas(Right(cadena1, 3))
End If
Case 8
cadena1 = decenas(Left(cadena1, 2)) & " millones " & centenas(Mid(cadena1, 3, 4)) & " mil " & centenas(Right(cadena1, 3))
Case 9
cadena1 = centenas(Left(cadena1, 3)) & " millones " & centenas(Mid(cadena1, 4, 3)) & " mil " & centenas(Right(cadena1, 3))
End Select
End If
If a = 2 Then
'empezamos con cadena 2, los decimales
n_caracteres = Len((cadena2))
Select Case n_caracteres
Case 1
cadena2 = cadena2 & 0
cadena2 = decenas(CInt(cadena2))
Case 2
cadena2 = decenas(CInt(cadena2))
End Select
If x = 2 Then
Select Case cadena2
Case "un"
En_letra = UCase(cadena1 & euro & "con " & cadena2 & " centimo.")
Case ""
En_letra = UCase(cadena1 & euro)
Case Else
En_letra = UCase(cadena1 & euro & "con " & cadena2 & " centimos.")
End Select
End If
End If
If a = 3 Then
n_caracteres = Len(cadena_m)
Select Case n_caracteres
Case 1
cadena_m = unidad(CInt(cadena_m))
Case 2
cadena_m = decenas(CInt(cadena_m))
Case 3
cadena_m = centenas(CInt(cadena_m))
Case 4
If Left(cadena_m, 1) = 1 Then
cadena_m = " mil " & centenas(Right(cadena_m, 3))
Else
cadena_m = unidad(Left(cadena_m, 1)) & " mil " & centenas(Right(cadena_m, 3))
End If
Case 5
cadena_m = decenas(Left(cadena_m, 2)) & " mil " & centenas(Right(cadena_m, 3))
Case 6
cadena_m = centenas(Left(cadena_m, 3)) & " mil " & centenas(Right(cadena_m, 3))
Case 7
If Left(cadena_m, 1) = 1 Then
cadena_m = "un millon " & centenas(Mid(cadena_m, 2, 3)) & " mil " & centenas(Right(cadena_m, 3))
Else
cadena_m = unidad(Left(cadena_m, 1)) & " millones " & centenas(Mid(cadena_m, 2, 3)) & " mil " & centenas(Right(cadena_m, 3))
End If
Case 8
cadena_m = decenas(Left(cadena_m, 2)) & " millones " & centenas(Mid(cadena_m, 3, 4)) & " mil " & centenas(Right(cadena_m, 3))
Case 9
cadena_m = centenas(Left(cadena_m, 3)) & " millones " & centenas(Mid(cadena_m, 4, 3)) & " mil " & centenas(Right(cadena_m, 3))
End Select
If x = 3 Then
If cadena2 = "" Then
En_letra = UCase(cadena_m & " mil " & cadena1 & euro)
Else
If cadena2 = "un" Then
En_letra = UCase(cadena_m & " mil " & cadena1 & euro & "con " & cadena2 & " centimo.")
Else
En_letra = UCase(cadena_m & " mil " & cadena1 & euro & "con " & cadena2 & " centimos.")
End If
End If
End If
End If
Next a
End Function
Private Function unidad(VALOR As Integer) As String
Select Case VALOR
Case 1
unidad = "un"
Case 2
unidad = "dos"
Case 3
unidad = "tres"
Case 4
unidad = "cuatro"
Case 5
unidad = "cinco"
Case 6
unidad = "seis"
Case 7
unidad = "siete"
Case 8
unidad = "ocho"
Case 9
unidad = "nueve"
Case 0
unidad = ""
End Select
End Function
Private Function decenas(VALOR As Integer)
'tenemos que distinguir entre once... doce... y los demás como siempre
Dim pepe
'si la longitud es un caracter, entonces llamamos a UNIDAD
If Len(CStr(VALOR)) = 1 Then
decenas = unidad(VALOR)
Exit Function
End If
'cojemos el primer dígito
pepe = Left(CStr(VALOR), 1)
Select Case pepe
Case 1
Select Case VALOR
Case 10
decenas = "diez"
Case 11
decenas = "once"
Case 12
decenas = "doce"
Case 13
decenas = "trece"
Case 14
decenas = "catorce"
Case 15
decenas = "quince"
Case 16
decenas = "dieciseis"
Case 17
decenas = "diecisiete"
Case 18
decenas = "dieciocho"
Case 19
decenas = "diecinueve"
End Select
Case 9
If Right(CStr(VALOR), 1) = 0 Then
decenas = "noventa"
Else
decenas = "noventa y " & unidad(CInt(Right(CStr(VALOR), 1)))
End If
Case Else
Select Case pepe
Case 2
If Right(CStr(VALOR), 1) = 0 Then
decenas = "veinte"
Else
decenas = "veinti" & unidad(Right(VALOR, 1))
End If
Case 3
If Right(CStr(VALOR), 1) = 0 Then
decenas = "treinta"
Else
decenas = "treinta y " & unidad(Right(VALOR, 1))
End If
Case 4
If Right(CStr(VALOR), 1) = 0 Then
decenas = "cuarenta"
Else
decenas = "cuarenta y " & unidad(Right(VALOR, 1))
End If
Case 5
If Right(CStr(VALOR), 1) = 0 Then
decenas = "cincuenta"
Else
decenas = "cincuenta y " & unidad(Right(VALOR, 1))
End If
Case 6
If Right(CStr(VALOR), 1) = 0 Then
decenas = "sesenta"
Else
decenas = "sesenta y " & unidad(Right(VALOR, 1))
End If
Case 7
If Right(CStr(VALOR), 1) = 0 Then
decenas = "setenta"
Else
decenas = "setenta y " & unidad(Right(VALOR, 1))
End If
Case 8
If Right(CStr(VALOR), 1) = 0 Then
decenas = "ochenta"
Else
decenas = "ochenta y " & unidad(Right(VALOR, 1))
End If
Case 0
decenas = "" & unidad(Right(VALOR, 1))
End Select
End Select
End Function
Private Function centenas(VALOR As Variant) As String
'si la cifra es de longitud uno, llamo a UNIDADES
If Len(CStr(CInt(VALOR))) = 1 Then
centenas = unidad(CInt(VALOR))
Exit Function
End If
'si la cifra es de longitud 2, llamo a DECENAS
If Len(CStr(CInt(VALOR))) = 2 Then
centenas = decenas(CInt(VALOR))
Exit Function
End If
Dim pepe As Integer
VALOR = CStr(CInt(VALOR))
pepe = Left(VALOR, 1)
Select Case pepe
Case 1
If VALOR = "100" Then
centenas = "cien"
Else
centenas = "ciento " & decenas(Mid(VALOR, 2))
End If
Case 2
centenas = "doscientos " & decenas(Mid(VALOR, 2))
Case 3
centenas = "trescientos " & decenas(Mid(VALOR, 2))
Case 4
centenas = "cuatrocientos " & decenas(Mid(VALOR, 2))
Case 5
centenas = "quinientos " & decenas(Mid(VALOR, 2))
Case 6
centenas = "seiscientos " & decenas(Mid(VALOR, 2))
Case 7
centenas = "setecientos " & decenas(Mid(VALOR, 2))
Case 8
centenas = "ochocientos " & decenas(Mid(VALOR, 2))
Case 9
centenas = "novecientos " & decenas(Mid(VALOR, 2))
End Select
End Function
Private Function comprueba(VALOR As String) As String
Dim coma As Integer
Dim cadena2 As String
coma = InStr(VALOR, ",")
'si no hay coma entonces le pongo dos ceros decimales
If coma = 0 Then
VALOR = VALOR & ",00"
End If
'recupero coma
coma = InStr(VALOR, ",")
'meto los decimales en cadena2
cadena2 = Mid(CStr(VALOR), coma + 1)
'si la len de cadena2=1 entonces le pongo un 0 al final
If Len(CStr(cadena2)) = 1 Then
VALOR = VALOR & 0
End If
comprueba = VALOR
End Function
Add to favourites
Subscribe comments
Copy code
Mail user
Add to friends