VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "ALetras" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Attribute VB_Description = "Clase para hallar el valor en letras de un numero dado." Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes" Attribute VB_Ext_KEY = "Top_Level" ,"Yes" Option Explicit Public Enum Estilos CentavosNumericos = 0 CentavosLetras = 1 End Enum Private JMonto As Variant Private JLetras As String Private JEstilo As Byte ' El numero en cadena de caracteres Private JMonLet As String Private JDecima As String * 3 ' Numero de grupos de a tres digitos en el numero Private NumGrupos As Integer ' Contiene cada grupo de tres digitos Private Grupo(1 To 5) As String * 3 'variables locales que contienen valores de propiedad Private mvarLetras As String 'copia local Public Property Get Letras(Optional Valor As Variant = 0) As String Attribute Letras.VB_UserMemId = 0 If Valor > 0 Then Monto = Valor Letras = JLetras End Property Public Property Get Estilo() As Estilos Estilo = JEstilo End Property Public Property Let Estilo(Valor As Estilos) JEstilo = Valor PasarAletras End Property ' Retorna el valor trabajado Public Property Get Monto() As Variant Monto = JMonto End Property ' Lee el valor a trabajar Public Property Let Monto(Valor As Variant) JMonto = Valor PasarAletras End Property ' Retorna el valor en letras 'Public Property Get Letras() ' Letras = JLetras 'End Property Private Sub PasarAletras() AsignarGrupos FormarCadena End Sub Private Sub AsignarGrupos() Dim LugPunto As Integer Dim Cuantos As Integer Dim Lng As Integer Dim L As Integer Dim I As Integer JMonLet = Format(JMonto, "############.##") Lng = Len(JMonLet) If Lng = 0 Then JLetras = "" JMonto = 0 Exit Sub End If LugPunto = InStr(1, JMonLet, ",") JDecima = Mid(JMonLet, LugPunto + 1) If Lng > 15 Or LugPunto > 13 Then Err.Number = 1 Err.Description = "El máximo valor soportado por" & _ "la clase Aletras es 999,999,999,999.99" Err.Raise 1 End If If LugPunto = 0 Then L = Lng Else L = LugPunto - 1 End If NumGrupos = L \ 3 + IIf(L Mod 3 = 0, 0, 1) I = L Mod 3 Select Case I Case 1 JMonLet = "00" + JMonLet Case 2 JMonLet = "0" + JMonLet End Select For I = 1 To Len(JMonLet) - 1 Step 3 Grupo(I \ 3 + 1) = Mid(JMonLet, I, 3) Next I End Sub Private Sub FormarCadena() Dim I As Integer JLetras = "" For I = 1 To NumGrupos JLetras = JLetras + Centenas(I) + Decenas(I) + Unidades(I) Next I JLetras = JLetras + " PESOS" If Val(JDecima) > 10 Then JDecima = "0" + JDecima ElseIf Val(JDecima) > 0 Then JDecima = "0" + Trim(JDecima) + "0" Else JLetras = JLetras + " M/CTE." Exit Sub End If If JEstilo = CentavosLetras Then NumGrupos = 1 Grupo(1) = JDecima JLetras = JLetras + " CON " + Decenas(1) + _ Unidades(1) + " CENTAVOS " Else JLetras = JLetras + " CON " + Right(JDecima, 2) + "/100" End If JLetras = JLetras + " M/CTE." End Sub Private Function Centenas(Ind As Integer) As String Dim C As String * 1 C = Mid(Grupo(Ind), 1, 1) Select Case Val(C) Case 0 If Ind = 1 Then Centenas = "" Else Centenas = " " End If Case 1 If Mid(Grupo(Ind), 2) = "00" Then Centenas = "CIEN" Else Centenas = "CIENTO " End If Case 2 Centenas = "DOSCIENTOS" Case 3 Centenas = "TRESCIENTOS" Case 4 Centenas = "CUATROCIENTOS" Case 5 Centenas = "QUINIENTOS" Case 6 Centenas = "SEISCIENTOS" Case 7 Centenas = "SETECIENTOS" Case 8 Centenas = "OCHOCIENTOS" Case 9 Centenas = "NOVECIENTOS" End Select If Val(C) > 2 Then Centenas = Centenas + " " End Function Private Function Decenas(Ind As Integer) As String Dim C As String * 1 C = Mid(Grupo(Ind), 2, 1) Select Case Val(C) Case 0 Decenas = "" Case 1 Select Case Val(Mid(Grupo(Ind), 3, 1)) Case 0 Decenas = "DIEZ" Case 1 Decenas = "ONCE" Case 2 Decenas = "DOCE" Case 3 Decenas = "TRECE" Case 4 Decenas = "CATORCE" Case 5 Decenas = "QUINCE" Case Else Decenas = "DIECI" End Select Case 2 If Val(Mid(Grupo(Ind), 3)) = 0 Then Decenas = "VEINTE" Else Decenas = "VEINTI" End If Case 3 Decenas = "TREINTA" Case 4 Decenas = "CUARENTA" Case 5 Decenas = "CINCUENTA" Case 6 Decenas = "SESENTA" Case 7 Decenas = "SETENTA" Case 8 Decenas = "OCHENTA" Case 9 Decenas = "NOVENTA" End Select If InStr(1, "123456789", Mid(Grupo(Ind), 3, 1)) > 0 _ And Val(C) > 2 Then Decenas = Decenas + " Y " End If End Function Private Function Unidades(Ind As Integer) As String Dim C As String * 1 Dim Dece As Byte Dim Difer As Byte C = Mid(Grupo(Ind), 3, 1) Dece = Val(Mid(Grupo(Ind), 2, 1)) If Val(C) = 0 Or (Dece = 1 And Val(C) < 6) Then Unidades = "" Else Select Case Val(C) Case 1 Unidades = "UN" Case 2 Unidades = "DOS" Case 3 Unidades = "TRES" Case 4 Unidades = "CUATRO" Case 5 Unidades = "CINCO" Case 6 Unidades = "SEIS" Case 7 Unidades = "SIETE" Case 8 Unidades = "OCHO" Case 9 Unidades = "NUEVE" End Select End If Difer = NumGrupos - Ind Select Case Difer Case 1 If Val(C) = 1 And Val(Mid(Grupo(Ind), 1, 2)) = 0 Then Unidades = "MIL " ElseIf Val(Mid(Grupo(Ind), 1, 3)) = 0 Then Unidades = "" Else Unidades = Unidades + " MIL " End If Case 2 If Val(C) = 1 And Val(Mid(Grupo(Ind), 1, 2)) = 0 Then Unidades = "UN MILLON " Else Unidades = Unidades + " MILLONES " End If Case 3 If Val(Grupo(Ind + 1)) = 0 Then Unidades = Unidades + " MIL MILLONES " ElseIf Val(C) = 1 Then Unidades = " MIL " Else Unidades = Unidades + " MIL " End If End Select End Function