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!!!
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?
esto yo lo investigue para facturar en excel para no tener problemas de ortografia y ahorrar tiempo, no se de donde seas tu pero si eres de mexico asi se hace, oye o para que quieres esto? saldos
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: & DECIMALES & "/100" & " M.N. "
seria de la misma manera la verdad es que no lo he intentado en exel 2007 pero supongo que sera asi saludos, checa si se puede si no yo despues hago una prebas
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....
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.
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("UN", "DOS", "TRES", "CUATRO", "CINCO", "SEIS", "SIETE", "OCHO", "NUEVE", "DIEZ", "ONCE", "DOCE", "TRECE", "CATORCE", "QUINCE", "DIECISEIS", "DIECISIETE", "DIECIOCHO", "DIECINUEVE", "VEINTE", "VEINTIUN", "VEINTIDOS", "VEINTITRES", "VEINTICUATRO", "VEINTICINCO", "VEINTISEIS", "VEINTISIETE", "VEINTIOCHO", "VEINTINUEVE" laDecenas = Array("DIEZ", "VEINTE", "TREINTA", "CUARENTA", "CINCUENTA", "SESENTA", "SETENTA", "OCHENTA", "NOVENTA" laCentenas = Array("CIENTO", "DOSCIENTOS", "TRESCIENTOS", "CUATROCIENTOS", "QUINIENTOS", "SEISCIENTOS", "SETECIENTOS", "OCHOCIENTOS", "NOVECIENTOS"
lnNumeroBloques = 1
Do
lnPrimerDigito = 0 lnSegundoDigito = 0 lnTercerDigito = 0 lcBloque = "" lnBloqueCero = 0 For I = 1 To 3 lnDigito = lyCantidad Mod 10 If lnDigito <> 0 Then Select Case I Case 1 lcBloque = " " & laUnidades(lnDigito - 1) lnPrimerDigito = lnDigito Case 2 If lnDigito <= 2 Then lcBloque = " " & laUnidades((lnDigito * 10) + lnPrimerDigito - 1) Else lcBloque = " " & laDecenas(lnDigito - 1) & IIf(lnPrimerDigito <> 0, " Y", Null) & lcBloque End If lnSegundoDigito = lnDigito Case 3 lcBloque = " " & IIf(lnDigito = 1 And lnPrimerDigito = 0 And lnSegundoDigito = 0, "CIEN", laCentenas(lnDigito - 1)) & 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 & IIf(lnBloqueCero = 3, Null, " MIL" & PesosMN Case 3 PesosMN = lcBloque & IIf(lnPrimerDigito = 1 And lnSegundoDigito = 0 And lnTercerDigito = 0, " MILLON", " MILLONES" & PesosMN End Select lnNumeroBloques = lnNumeroBloques + 1 Loop Until lyCantidad = 0 PesosMN = "SON: (" & PesosMN & IIf(tyCantidad > 1, " PESOS ", " PESO " & Format(Str(lyCentavos), "00" & "/100 M.N.)" End Function
Igual ambos codigos tienen detalles con numeros fraccionarios entre 1 y 2, pero bueno ya es demasiado bueno el codigo
La verdad es que ya salio! me ahorrastes tipear el monto de mas de cien recibos por mes!
por nada saludos, s le quieres cambiar en todas las partes donde dice "m.n." ponle con, pero sin quitar las comillas quedand de esta manera "CON" SALUDOS
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...
68 comentarios
TRES MIL CUATROCIENTOS CINCUENTA PESOS 46/100 M.N.
Se pueden quitar esos numeros de al final?
MUCHÍSIMAS GRACIAS!!!
Pasame un MP y te dejo puntos mañana!
Salu2
Orale mil gracias son mis primero 10 puntos
muy bueno sigue asi y mejoraras
eso espero gracias por los comentarios
En el 2010 no lo pongo aun, pero deja hago la prueba, y te aviso, ok gracias
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
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("UN", "DOS", "TRES", "CUATRO", "CINCO", "SEIS", "SIETE", "OCHO", "NUEVE", "DIEZ", "ONCE", "DOCE", "TRECE", "CATORCE", "QUINCE", "DIECISEIS", "DIECISIETE", "DIECIOCHO", "DIECINUEVE", "VEINTE", "VEINTIUN", "VEINTIDOS", "VEINTITRES", "VEINTICUATRO", "VEINTICINCO", "VEINTISEIS", "VEINTISIETE", "VEINTIOCHO", "VEINTINUEVE"
laDecenas = Array("DIEZ", "VEINTE", "TREINTA", "CUARENTA", "CINCUENTA", "SESENTA", "SETENTA", "OCHENTA", "NOVENTA"
laCentenas = Array("CIENTO", "DOSCIENTOS", "TRESCIENTOS", "CUATROCIENTOS", "QUINIENTOS", "SEISCIENTOS", "SETECIENTOS", "OCHOCIENTOS", "NOVECIENTOS"
lnNumeroBloques = 1
Do
lnPrimerDigito = 0
lnSegundoDigito = 0
lnTercerDigito = 0
lcBloque = ""
lnBloqueCero = 0
For I = 1 To 3
lnDigito = lyCantidad Mod 10
If lnDigito <> 0 Then
Select Case I
Case 1
lcBloque = " " & laUnidades(lnDigito - 1)
lnPrimerDigito = lnDigito
Case 2
If lnDigito <= 2 Then
lcBloque = " " & laUnidades((lnDigito * 10) + lnPrimerDigito - 1)
Else
lcBloque = " " & laDecenas(lnDigito - 1) & IIf(lnPrimerDigito <> 0, " Y", Null) & lcBloque
End If
lnSegundoDigito = lnDigito
Case 3
lcBloque = " " & IIf(lnDigito = 1 And lnPrimerDigito = 0 And lnSegundoDigito = 0, "CIEN", laCentenas(lnDigito - 1)) & 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 & IIf(lnBloqueCero = 3, Null, " MIL"
Case 3
PesosMN = lcBloque & IIf(lnPrimerDigito = 1 And lnSegundoDigito = 0 And lnTercerDigito = 0, " MILLON", " MILLONES"
End Select
lnNumeroBloques = lnNumeroBloques + 1
Loop Until lyCantidad = 0
PesosMN = "SON: (" & PesosMN & IIf(tyCantidad > 1, " PESOS ", " PESO "
End Function
Igual ambos codigos tienen detalles con numeros fraccionarios entre 1 y 2, pero bueno ya es demasiado bueno el codigo
saludos
De nada saludos
gracias, Saludos
por nada saludos, s le quieres cambiar en todas las partes donde dice "m.n." ponle con, pero sin quitar las comillas quedand de esta manera "CON" SALUDOS
Orale que bueno que te sirva, saludos, Gracias por los puntos
De nada, se que no se piden los puntos pero si tienes dejame unos no Saludos
por nada Saludos!
De nada Saludos...
un millon pesos 00/100 m.n.
es correcto este termino.
Te dejo 10 y reco.
Saludos.
De nada saludos.
gracias te dejo +10
Oye por que dices que dejas mas 10 y si no tienes puntos, que bueno que te haya servido.
que bien muchas gracias, ya mero obtengo mis 50 puntos Saludos
compartiendo hacemos mas =D
Gracias bro!