landazuri6

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!!!

Saludos a todos No sabia donde postearlo así que lo dejo aquí, solo por hoy por darle me gusta a la pagina de netload, este les regalara un voucher (cupón) por 7 días de cuenta premium. solo darle me gusta http://www.facebook.com/netload?sk=wall ojalas les sirva, hay hartos archivos subidos a este servidor y pueden descargar una semana a cagar xD Es solo por hoy así que háganlo ahora sha xd saludos Me Gusta