Programación General > Visual Basic 6.0 e inferiores
Aportando Código
(1/1)
Castord:
Este ejemplo que desarrollé me sirvió bastante a la hora de imprimir en programas de facturación y demás... muy útil aquí y pienso que en otras partes del mundo.. :D
Lée números y los imprime en su formato alfabetico(letras)
--- Código: Text --- '===============================================' ALGORITMO DE LECTURA DE NUMEROS ENTEROS'con un rango comprendido entre 1 y 999.999.999'==============================================='(C)Carlos Ruiz Díaz - Castord'Asunción, 31-ENE-2007, Paraguay'Todos los Derechos Reservados'Carlos.RuizDiaz@gmail.com'----------------------------------------------'NO SE HACEN TODAS LAS VALIDACIONES NECESARIAS!' Código vb5, vb6 Win32 compatible' | CONTROLES |'un text box, name=Text1'un command button, name=Command1'----------------------------------------------'por favor, si encuentran bugs o realizan alguna'clase de optimización, reportenmelo al mail'adjunto, gracias.'=============================================== Dim Unidades(1 To 9) As StringDim Decenas(1 To 9) As StringDim Especiales(11 To 19) As StringDim Lect(1 To 3) As StringDim nLect(1 To 3) As Integer'---------------------------------'Dim Millar As StringDim Cent As String'Dim Veinti As StringDim Centenas(1 To 9) As StringDim Grupo As Integer'--------------------------------- Function Leer(Nro As String) As Boolean'On Error GoTo Error'On Error Resume NextDim Unidad As String, Decena As String, Centena As StringDim Cifras As IntegerDim Aux As String, Parte As String Aux = vbNullString Debug.Print Nro If Val(Nro) = 0 Then 'si la cadena es por ej. '000' resultante del nro 1.000 Grupo = Grupo + 1 Lect(Grupo) = Aux Exit Function 'saleEnd If Cifras = Len(Nro) Parte = Mid(Nro, 1, 1) 'extrae las centenasIf Parte > 0 Then 'si es mayor a cero se consulta al vector y se asigna ya el texto respectivo Aux = Centenas(Parte)End IfParte = CInt(Right(Nro, 2)) 'extrae unidad y decena Unidad = CInt(Right(Nro, 1))Debug.Print UnidadDecena = CInt(Mid(Nro, 2, 1))Debug.Print DecenaCentena = CInt(Left(Nro, 1))Debug.Print Centena '======se explicar por si solas algunas condicionales====== If Centena = 0 And Decena = 0 And Unidad > 0 Then 'para '001' por ej. Aux = Unidades(Unidad) ElseIf Unidad = 0 And Decena = 0 And Centena > 0 Then '100' por ej. If Centena = 1 Then 'para cien Aux = "cien" Else '`para versiones 'ciento'.. .ej. 101 Aux = Centenas(Mid(Nro, 1, 1)) End If ElseIf Decena = 0 And Unidad > 0 Then '01' por ej. Aux = Aux & " " & Unidades(Unidad) ElseIf Unidad = 0 And Decena > 0 Then '10' por ej. Decena = Mid(Nro, 2, 1) Aux = Aux & " " & Decenas(CInt(Decena)) ElseIf Parte < 20 Then 'para las versiones 'dieci', sin esto el resultado seria 'diez uno si el nro fuera 11 Aux = Aux & " " & Especiales(Parte) ElseIf Parte > 20 And Parte < 30 Then 'para las versiones 'veinti', sin esto el resultado seria 'veinte uno si el nro fuera 21 Parte = CInt(Mid(Nro, 3, 1)) Aux = Aux & " Veinti" & Unidades(Parte) Else 'para nros, sin ceros >30 y bla bla Parte = CInt(Mid(Nro, 2, 1)) Aux = Aux & " " & Decenas(Parte) Parte = CInt(Mid(Nro, 3, 1)) Aux = Aux & " y " & Unidades(Parte) End If 'LOS VALORES LLEGAN DE DERECHA A IZQUIERDA... En el nro. 1.000.123 se leerá 1ro.'la porcion '123' 'el vector Lect(1)=CENTENAS'el vector Lect(2)=MILLARES'el vector Lect(3)=MILLONES Grupo = Grupo + 1 'determina que parte se esta leyendoLect(Grupo) = Aux 'coloca aqui el textonLect(Grupo) = Val(Nro) 'coloca aqui el nro.Nro = vbNullStringLeer = TrueExit FunctionError: Leer = False MsgBox Err.DescriptionEnd Function Function SetearNro() As BooleanOn Error GoTo ErrorDim Nro As String, Parte As String, Limit As IntegerNro = Text1.TextIf Val(Nro) > 999999999 Or Val(Nro) < 1 Then MsgBox "Error en rango de lectura", vbInformation MsgBox "1 al 999.999.999 nomás!" SetearNro = False Exit FunctionEnd If'el programa toma los nros como cadenas de 3 caracteres por lo que esta sub es'muy necesaria para que funcione If Len(Nro) < 3 Then 'si el nro fue por ej. '3' el resultado será '003' ' para satisfacer la condicion Nro = String(3 - Len(Nro), "0") & Nro 'MsgBox NroEnd If Parte = vbNullString 'los nros de descomponen al estilo notacional corriente... ej. 1.000.000'donde el . (punto) es el separador de millares '=====determinar el limite del bucle======='ej... el nro 100.000 tiene dos partes de 3 cifras por lo que'de acuerdo el algoritmo de abajo el limite es 2. En el nro 1.100.123'se tiene dos partes de 3 cifras y una de una cifra pero el bucle se debe ejecutar'3 veces para poder tomar tb. el '1', ya que las porciones '100' y '123' cumplen'con las condiciones de 3 cifras... para el caso del '1' se correrá el algoritmo'correspondiente para comvertirlo a '001' y formar asi el nro 001.100.123 compatible If (Len(Nro) / 3) > (Round(Len(Nro) / 3)) Then Limit = Round(Len(Nro) / 3) + 1Else Limit = Len(Nro) / 3End If For i = 1 To LimitDebug.Print Nro If Len(Nro) < 3 Then 'para nros de de longitud menor a 3, nunca debe entrar a la 1ra. Nro = String(3 - Len(Nro), "0") & Nro 'Nro = Right(Nro, Len(Nro)) 'MsgBox Nro Leer (Nro) 'pasa el arg. a la funcion de lectura Debug.Print Nro Else Parte = Right(Nro, 3) 'leer las ultimas 3 cifras del nro Debug.Print Parte Leer (Parte) Nro = Left(Nro, Len(Nro) - 3) 'extraer la parte leida de la cadena original Debug.Print Nro 'y reasignar a la var original el resto de la 'cadena descompuesta End IfNextSetearNro = TrueExit FunctionError: MsgBox Err.Description SetearNro = FalseEnd FunctionPrivate Sub Command1_Click()Dim ok As Booleanok = SetearNroIf ok = False Then Exit SubEnd If '=========================================='diferenciar los millones, miles y centenas'==========================================Dim Texto As StringTexto = vbNullString If Lect(3) <> vbNullString Then 'millones If nLect(3) = 1 Then Texto = "Un millón " Else Texto = Lect(3) & " millones " End IfEnd IfIf Lect(2) <> vbNullString Then 'miles 'If nLect(2) = 1 Then ' Texto = Texto & Lect(2) & " mil " 'Else Texto = Texto & Lect(2) & " mil " 'End IfEnd IfIf Lect(1) <> vbNullString Then 'centenas Texto = Texto & Lect(1)End If Texto = Trim(Texto) 'sacar de la cadena los espacios en blanco en ambos lados'MsgBox Texto, , "TEXTO SIN FORMATO TITULO"MsgBox Estilo(Texto) 'texto en estilo titulo. 'Ej. "ani reñembotavy nde tembo" se verá 'como "Ani Reñembotavy Nde Tembo"'================' Reinicializar'================Grupo = 0For i = 1 To UBound(Lect, 1) Lect(i) = vbNullString nLect(i) = 0NextEnd Sub Function Estilo(Texto As String) As String'On Error Resume NextDim i As Integer, Pos As String, SubStrPre As String, SubStrPos As StringDim MayusChar As StringDim Char As StringDim n As StringFor i = 1 To Len(Texto) Pos = InStr(i, Texto, " ") 'buscar espacios en blanco Debug.Print Pos Char = Mid(Texto, Pos + 1, 1) 'extraer el caracter luego del espacio en blaco Debug.Print Char SubStrPre = Left(Texto, Pos) 'extraer al cadena anterior al caracter Debug.Print SubStr SubStrPos = Right(Texto, Len(Texto) - (Pos + 1)) 'extraer la cadena posterior al char Debug.Print SubStrPos MayusChar = UCase(Char) 'convertir el char a su version muyuscula Texto = SubStrPre & MayusChar & SubStrPos 'concatenar la cadena anterior el caracter 'y la cadena posterior en la var original Debug.Print TextoNextEstilo = Texto End Function Private Sub Command3_Click()MsgBox Estilo(Text1.Text)End Sub Private Sub Form_Load()'VECTORES DE CADENASUnidades(1) = "uno"Unidades(2) = "dos"Unidades(3) = "tres"Unidades(4) = "cuatro"Unidades(5) = "cinco"Unidades(6) = "seis"Unidades(7) = "siete"Unidades(8) = "ocho"Unidades(9) = "nueve" Especiales(11) = "once"Especiales(12) = "doce"Especiales(13) = "trece"Especiales(14) = "catorce"Especiales(15) = "quince"Especiales(16) = "dieciseis"Especiales(17) = "diecisiete"Especiales(18) = "dieciocho"Especiales(19) = "diecinueve" Decenas(1) = "diez"Decenas(2) = "veinte"Decenas(3) = "treinta"Decenas(4) = "cuarenta"Decenas(5) = "cincuenta"Decenas(6) = "sesenta"Decenas(7) = "setenta"Decenas(8) = "ochenta"Decenas(9) = "noventa" Centenas(1) = "ciento"Centenas(2) = "doscientos"Centenas(3) = "trescientos"Centenas(4) = "cuatrocientos"Centenas(5) = "quinientos"Centenas(6) = "seiscientos"Centenas(7) = "setecientos"Centenas(8) = "ochocientos"Centenas(9) = "novecientos" 'Veinti = "veinti"'Millar = "mil" End Sub
Castord:
ahhh...
fíjense y comenten :D
ElNapster:
Al ingresar un valor fuera del rango te da una alerta, al querer yo ingresar otro valor permitido me siguie dando error ... me imagino que no se debe de estar limpiando una variable por ahi...
Pero esta interesante tu aporte ...... B)
... va otra ingresa este valor 10g6 y veras el mensaje que te da .. :scream:
Castord:
si... pasa que aclaré que no se verifican todas las variables ingresadas, puse eso como comentario...
fijate..
además... suprimí esa parte de validaciones porque la funcion que llamaba a escribir nros. siempre enviaba datos validos..
tb. se del 'error gramatical' al llamar a nros. como 1029... pasa que ignore eso debido a que las facturas aca siempre superan los millones...
Navegación
Ir a la versión completa