Poner cantidad con letra en Excel automaticamente!!!!

Saludos a todos espero que este por les guste y sea de su agrado, bueno este post es decicado a excel ya que hay algunos que lo utilizan para realizar facturas y tienen que escribir la cantida letra por letra pues ya no mas tiene la opcion de que lo ponga automaticamente, lo primero que tienen que hacer es copiar el sigiente texto en esta direccion; se van a editor de VisualBasic, Herramientas-Macro-Editor de VisualBasic- de ahi les abrira el editor, ya en el editor se van a Insertar-Modulo- y en la ventana que les abre pegan el codigo. despues de eso sierran todo y guardan loos cambios, vuelven a abrir el archivo y para activar la funcion se posisionan donde quiera que aparesca la cantidad en letra depsues se van a Insertar-funcion- les abrira uan ventana de ahi se van (seleccionar una categoria y seleccionan DEFINIDAS POR EL USUARIO) les va a salir una opcion CONVIERTENUMLETRA la seleccionan y les habre una ventana donde tiene que selecsionar la casilla donde esta la cantidd con mumero le dan aceptar y es todo señores tiene su cantidad con letra automaticamente... el codigo es el siguiente...
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





Espero les sirva este post espero sus comentarios y cualquier duda aganmela saber yo los guio... saludos!!!

Fuentes de Información - Poner cantidad con letra en Excel automaticamente!!!!

Dar puntos
136 Puntos
Votos: 23 - T!score: 6/10
  • 6 Seguidores
  • 105.476 Visitas
  • 35 Favoritos

75 comentarios - Poner cantidad con letra en Excel automaticamente!!!!

@avimael Hace más de 5 años
apantallador eh-! 1000 grax
@PEEWEE2009 Hace más de 5 años
como seria para el excel del office 2007??
@jamess005 Hace más de 4 años
Hola... que buen consejo... una pregunta..cuando sale la cantidad en letra al final salen unos numeros por ejemplo:
TRES MIL CUATROCIENTOS CINCUENTA PESOS 46/100 M.N.
Se pueden quitar esos numeros de al final?
@cristinakity Hace más de 4 años
Muchas gracias (Y) muy bueno . Hola jamess005 si no es demasiado tarde si se peude quitar la parte de 46/100 M.N. solo quitas esta parte del codigo: &amp; DECIMALES &amp; &quot;/100&quot; &amp; &quot; M.N. &quot;
@jorgecriador Hace más de 4 años
como lo activo en exel 2007
@GrupOne Hace más de 3 años
BUENOOO
@hsad10 Hace más de 3 años
MUY BUEN APORTE!!!
MUCHÍSIMAS GRACIAS!!!
Pasame un MP y te dejo puntos mañana!
@jorge258mx Hace más de 3 años
Hola muy buena aplicacion nada mas que tengo un problema en mi hoja de exel 2007 tengo el subtotal, iva y total, y en esta casilla esta la suma de estas y no me pone con letras la cantidad dice #¿NOMBRE? porque en la formula esta G40+G38 que tengo que hacer Gracias....
@hsad10 Hace más de 3 años
Te dejé los puntos como te prometí!
Salu2
@JONAJUEGOS Hace más de 3 años
landazuri6 dijo:
hsad10 dijo:MUY BUEN APORTE!!!
MUCHÍSIMAS GRACIAS!!!
Pasame un MP y te dejo puntos mañana!


Orale mil gracias son mis primero 10 puntos

muy bueno sigue asi y mejoraras
@Llorche09 Hace más de 3 años
Excelente post, gran labor, felicidades, no puedo dar puntos sorry, sigue asi
@Aume_Faunt Hace más de 3 años
disculpa como lo activo para office 2010???
@alemarort Hace más de 3 años
Pues con la novedad de que este codigo funciona perfecto,
pero una ves que guardo y cierro el archivo, al volver a abrirlo
me invalida la funcion, asi que ya no es util. y tengo que volver a
insertar el codigo.

Tanto en Office 2007 y 2010
@manobach Hace más de 3 años
Aqui tienen otro codigo, creo mas corto e igualmente funciona. Parece que en versiones de 2007 y 2010 es necesario salvar el archivo en formato xlsm ( formato de hoja excel habilitada para macros para que la funcion permanezca.

Function PesosMN(tyCantidad As Currency) As String
Dim lyCantidad As Currency, lyCentavos As Currency, lnDigito As Byte, lnPrimerDigito As Byte, lnSegundoDigito As Byte, lnTercerDigito As Byte, lcBloque As String, lnNumeroBloques As Byte, lnBloqueCero
Dim laUnidades As Variant, laDecenas As Variant, laCentenas As Variant, I As Variant 'Si esta como Option Explicit
tyCantidad = Round(tyCantidad, 2)
lyCantidad = Int(tyCantidad)
lyCentavos = (tyCantidad - lyCantidad) * 100
laUnidades = Array(&quot;UN&quot;, &quot;DOS&quot;, &quot;TRES&quot;, &quot;CUATRO&quot;, &quot;CINCO&quot;, &quot;SEIS&quot;, &quot;SIETE&quot;, &quot;OCHO&quot;, &quot;NUEVE&quot;, &quot;DIEZ&quot;, &quot;ONCE&quot;, &quot;DOCE&quot;, &quot;TRECE&quot;, &quot;CATORCE&quot;, &quot;QUINCE&quot;, &quot;DIECISEIS&quot;, &quot;DIECISIETE&quot;, &quot;DIECIOCHO&quot;, &quot;DIECINUEVE&quot;, &quot;VEINTE&quot;, &quot;VEINTIUN&quot;, &quot;VEINTIDOS&quot;, &quot;VEINTITRES&quot;, &quot;VEINTICUATRO&quot;, &quot;VEINTICINCO&quot;, &quot;VEINTISEIS&quot;, &quot;VEINTISIETE&quot;, &quot;VEINTIOCHO&quot;, &quot;VEINTINUEVE&quot
laDecenas = Array(&quot;DIEZ&quot;, &quot;VEINTE&quot;, &quot;TREINTA&quot;, &quot;CUARENTA&quot;, &quot;CINCUENTA&quot;, &quot;SESENTA&quot;, &quot;SETENTA&quot;, &quot;OCHENTA&quot;, &quot;NOVENTA&quot
laCentenas = Array(&quot;CIENTO&quot;, &quot;DOSCIENTOS&quot;, &quot;TRESCIENTOS&quot;, &quot;CUATROCIENTOS&quot;, &quot;QUINIENTOS&quot;, &quot;SEISCIENTOS&quot;, &quot;SETECIENTOS&quot;, &quot;OCHOCIENTOS&quot;, &quot;NOVECIENTOS&quot

lnNumeroBloques = 1

Do

lnPrimerDigito = 0
lnSegundoDigito = 0
lnTercerDigito = 0
lcBloque = &quot;&quot;
lnBloqueCero = 0
For I = 1 To 3
lnDigito = lyCantidad Mod 10
If lnDigito &lt;&gt; 0 Then
Select Case I
Case 1
lcBloque = &quot; &quot; &amp; laUnidades(lnDigito - 1)
lnPrimerDigito = lnDigito
Case 2
If lnDigito &lt;= 2 Then
lcBloque = &quot; &quot; &amp; laUnidades((lnDigito * 10) + lnPrimerDigito - 1)
Else
lcBloque = &quot; &quot; &amp; laDecenas(lnDigito - 1) &amp; IIf(lnPrimerDigito &lt;&gt; 0, &quot; Y&quot;, Null) &amp; lcBloque
End If
lnSegundoDigito = lnDigito
Case 3
lcBloque = &quot; &quot; &amp; IIf(lnDigito = 1 And lnPrimerDigito = 0 And lnSegundoDigito = 0, &quot;CIEN&quot;, laCentenas(lnDigito - 1)) &amp; lcBloque
lnTercerDigito = lnDigito
End Select
Else
lnBloqueCero = lnBloqueCero + 1
End If
lyCantidad = Int(lyCantidad / 10)
If lyCantidad = 0 Then
Exit For
End If
Next I
Select Case lnNumeroBloques
Case 1
PesosMN = lcBloque
Case 2
PesosMN = lcBloque &amp; IIf(lnBloqueCero = 3, Null, &quot; MIL&quot &amp; PesosMN
Case 3
PesosMN = lcBloque &amp; IIf(lnPrimerDigito = 1 And lnSegundoDigito = 0 And lnTercerDigito = 0, &quot; MILLON&quot;, &quot; MILLONES&quot &amp; PesosMN
End Select
lnNumeroBloques = lnNumeroBloques + 1
Loop Until lyCantidad = 0
PesosMN = &quot;SON: (&quot; &amp; PesosMN &amp; IIf(tyCantidad &gt; 1, &quot; PESOS &quot;, &quot; PESO &quot &amp; Format(Str(lyCentavos), &quot;00&quot &amp; &quot;/100 M.N.)&quot;
End Function

Igual ambos codigos tienen detalles con numeros fraccionarios entre 1 y 2, pero bueno ya es demasiado bueno el codigo

saludos
@luis374 Hace más de 1 año
Ese no Funciona el del post si Funciona al cien
@jorgemexesme Hace más de 3 años
VIENTOS HERMANO MUY BUEN POST
@gsilos Hace más de 3 años
Excelente aporte, de lo que he encontrado aquí, es de lo mejor. Felicidades y sigue así.
@LeosiLeo Hace más de 3 años
de todos los que busue es el que mas me sirvio. Pregunta? si quiero sacarle las letras M.N. y quiero agregarle la palabra &quot;con&quot; en el medio?
@LeosiLeo Hace más de 3 años
La verdad es que ya salio! me ahorrastes tipear el monto de mas de cien recibos por mes!
@myna7857 Hace más de 3 años
Excelente Post amigo me sirvió muchísimo
@ba51d Hace más de 3 años
Excelente, ya me daba hueva ecribir la cantidad cada vez. XD
@ricky33435 Hace más de 3 años
chido -... excelente me sirvio muchisimo tu post
@Neoclom Hace más de 3 años
gRACIAS
@DEAD_YAIR Hace más de 3 años
FANTASTICO!!!!!PERDI MUCHO TIEMPO PORBANDO OTRAS OPCIONES ,PERO ESTA ME FACILITO LA VIDAAAAA...MIL GRACIASSSSSS...SALUDOS!!!!
@jopeca2020 Hace más de 3 años
justo lo que necesitaba, pero en un millon lo marca de la siguiente forma

un millon pesos 00/100 m.n.

es correcto este termino.
@djmaster777 Hace más de 2 años
Gracias por la info!
Te dejo 10 y reco.

Saludos.
@ledssony Hace más de 2 años
muy buen aporte... funciona perfectamente
gracias te dejo +10
@arquichato Hace más de 2 años
como corregir cuando escribes 1,000,000 te dice: un millon pesos lo mismo con 10 millones, etc. ojala alguien sepa como corregirlo
@arquichato Hace más de 2 años
cuando escribes 1,000,000 te dice: un millon pesos lo mismo con 10 millones, etc. ojala alguien sepa como se corrige.
@DesdeLaCumbre Hace más de 2 años
Ahi te di lo que me quedaba
@dj3r Hace más de 2 años
gracias felicidades, y también a nosotros por tener ayuda como la tuya al servicio de los mortales. como te dejo puntos solo así
@Arces14 Hace más de 2 años
Brother te sacaste un 10 man, desde hace tiempo vengo pensando como se podría hacer esto, y diste la solución, muchísimas gracias por tomarte la molestia de subirlo, espero también poder compartir posteriormente algo que sea de utilidad para los demas...

compartiendo hacemos mas =D

Gracias bro!