Convertir Números a Letras

FUNCIONES PARA CONVERTIR NUMEROS A LETRAS

 

Function CONVIERTENUMLETRA(NUMERO)
Dim TEXTO
Dim MILLONES
Dim MILES
Dim CIENTOS
Dim DECIMALES
Dim CADENA
Dim CADMILLONES
Dim CADMILES
Dim CADCIENTOS
TEXTO = NUMERO
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, 1)
CADMILES = CONVIERTECIFRA(MILES, 1)
CADCIENTOS = CONVIERTECIFRA(CIENTOS, 0)
If Trim(CADMILLONES) > "" Then
If Trim(CADMILLONES) = "UN" Then
CADENA = CADMILLONES & " MILLON"
Else
CADENA = CADMILLONES & " MILLONES"
End If
End If
If Trim(CADMILES) > "" Then
 If CADENA = "" And Trim(CADMILES) = "MIL" Then
 CADENA = "MIL"
 Else
 CADENA = CADENA & " " & CADMILES & " MIL"
End If
End If

If Trim(CADMILES & CADCIENTOS) = "UN" Then
CADENA = CADENA & "UNO CON" & DECIMALES & "/100" & " M.N. "
Else
If MILES & CIENTOS = "000000" Then
CADENA = CADENA & " " & Trim(CADCIENTOS) & " CON " & DECIMALES & "/100" & " DOLARES "
Else
CADENA = CADENA & " " & Trim(CADCIENTOS) & " CON " & DECIMALES & "/100" & " DOLARES "
End If
End If
CONVIERTENUMLETRA = Trim(CADENA)
End Function

Function CONVIERTECIFRA(TEXTO, SW)
Dim CENTENA
Dim DECENA
Dim UNIDAD
Dim TXTCENTENA
Dim TXTDECENA
Dim TXTUNIDAD
CENTENA = Mid(TEXTO, 1, 1)
DECENA = Mid(TEXTO, 2, 1)
UNIDAD = Mid(TEXTO, 3, 1)
Select Case CENTENA
Case "1"
TXTCENTENA = "CIEN"
If DECENA & UNIDAD <> "00" Then
TXTCENTENA = "CIENTO"
End If
Case "2"
TXTCENTENA = "DOSCIENTOS"
Case "3"
TXTCENTENA = "TRESCIENTOS"
Case "4"
TXTCENTENA = "CUATROCIENTOS"
Case "5"
TXTCENTENA = "QUINIENTOS"
Case "6"
TXTCENTENA = "SEISCIENTOS"
Case "7"
TXTCENTENA = "SETECIENTOS"
Case "8"
TXTCENTENA = "OCHOCIENTOS"
Case "9"
TXTCENTENA = "NOVECIENTOS"
End Select

Select Case DECENA
Case "1"
TXTDECENA = "DIEZ"
Select Case UNIDAD
Case "1"
TXTDECENA = "ONCE"
Case "2"
TXTDECENA = "DOCE"
Case "3"
TXTDECENA = "TRECE"
Case "4"
TXTDECENA = "CATORCE"
Case "5"
TXTDECENA = "QUINCE"
Case "6"
TXTDECENA = "DIECISEIS"
Case "7"
TXTDECENA = "DIECISIETE"
Case "8"
TXTDECENA = "DIECIOCHO"
Case "9"
TXTDECENA = "DIECINUEVE"
End Select
Case "2"
TXTDECENA = "VEINTE"
If UNIDAD <> "0" Then
TXTDECENA = "VEINTI"
End If
Case "3"
TXTDECENA = "TREINTA"
If UNIDAD <> "0" Then
TXTDECENA = "TREINTA Y "
End If
Case "4"
TXTDECENA = "CUARENTA"
If UNIDAD <> "0" Then
TXTDECENA = "CUARENTA Y "
End If
Case "5"
TXTDECENA = "CINCUENTA"
If UNIDAD <> "0" Then
TXTDECENA = "CINCUENTA Y "
End If
Case "6"
TXTDECENA = "SESENTA"

If UNIDAD <> "0" Then
TXTDECENA = "SESENTA Y "
End If
Case "7"
TXTDECENA = "SETENTA"
If UNIDAD <> "0" Then
TXTDECENA = "SETENTA Y "
End If
Case "8"
TXTDECENA = "OCHENTA"
If UNIDAD <> "0" Then
TXTDECENA = "OCHENTA Y "
End If
Case "9"
TXTDECENA = "NOVENTA"
If UNIDAD <> "0" Then
TXTDECENA = "NOVENTA Y "
End If
End Select

If DECENA <> "1" Then
Select Case UNIDAD
Case "1"
If SW Then
TXTUNIDAD = "UN"
Else
TXTUNIDAD = "UNO"
End If
Case "2"
TXTUNIDAD = "DOS"
Case "3"
TXTUNIDAD = "TRES"
Case "4"
TXTUNIDAD = "CUATRO"
Case "5"
TXTUNIDAD = "CINCO"
Case "6"
TXTUNIDAD = "SEIS"
Case "7"
TXTUNIDAD = "SIETE"
Case "8"
TXTUNIDAD = "OCHO"
Case "9"
TXTUNIDAD = "NUEVE"
End Select
End If
CONVIERTECIFRA = TXTCENTENA & " " & TXTDECENA & TXTUNIDAD
End Function

Sub iniC()
Dim s As String
Dim N As Double
N = 12754.35
s = CONVIERTENUMLETRA(N)
MsgBox s
End Sub