DESCARGADO DE [Link].
com VISÍTALA Y ENCUENTRA MUCHOS RECURSOS
INFORMÁTICOS
EL CÓDIGO COPIALO TODO A PARTIR DE LA LINEA QUE COMIENZA POR FUNCTION,
JUSTO DESPUÉS DE LOS GUIONES
- - - - - - - - - - - - - - - - - - -
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
CADENA = CADENA & " " & CADMILES & " MIL"
END IF
IF TRIM(CADMILES & CADCIENTOS) = "UN" THEN
CADENA = CADENA & "UNO PESOS" & DECIMALES & "/100" & " M.N. "
ELSE
IF MILES & CIENTOS = "000000" THEN
CADENA = CADENA & " " & TRIM(CADCIENTOS) & " PESOS " & DECIMALES &
"/100" & " M.N. "
ELSE
CADENA = CADENA & " " & TRIM(CADCIENTOS) & " PESOS " & DECIMALES &
"/100" & " M.N. "
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
FUNCION PARA CONVERTIR NUMERO A LETRAS.
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
D1 = Array("ONCE", "DOCE", "TRECE", "CATORCE", "QUINCE", "DIECISEIS", "DIECISIETE", _
"DIECIOCHO", "DIECINUEVE")
D2 = Array("DIEZ", "VEINT", "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 & "E"
Else
Cad1 = Cad1 & "I"
Cad1 = Cad1 & Unidades(num1 Mod 10, 0)
End If
End If
End If
Decenas = Cad1
End Function
Function Cientos(num2)
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)
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)
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
num1 = cantm \ 1000000
num2 = cantm - (num1 * 1000000)
cents = (num2 * 100) Mod 100
If cents <= 9 Then
cents1 = "0" & cents
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 = "(" & cantlm & " PESOS " & cents1 & "/100 M.N. )"
Else
letras = "(" & cantlm & " DOLARES " & cents1 & "/100 U.S.D. )"
End If
End Function
Sub prueba()
Dim res As String, num As Single
num = 50899697. 51
res = letras(num, 1)
End Sub
Al finalizar cierren y solo manden llamar la formula como :
=letras(aqui ponen la celda donde viene el numero,1) si es pesos mexicanos
y si es dolares llaman:
=letras(aqui ponen la celda donde viene el numero,2)
Si cambian la denominacion a otras monedas solo modifiquen la macro casi al final donde viene "pesos" a su moneda
tambien entre comillas y quiten M.N.
ES OTRA FUNCION
