CONVERTIR DE NUMEROS A LETRAS

CONVERTIR DE NUMEROS A LETRAS **' '** AUTOR: OSCAR JAVIER LEON AVENDAÑO **' '** licencia: USO LIBRE **' '** http:www.oscarjleon.com **' '** FECHA DE CREACION: NOV.1991 **' '** **' '********************************************************************** Public Function CLetras(ByVal numero As Double, Optional fmtoUnidad As Integer = 0, Optional Unidades As String = "Kilos", Optional Unidad As String = "Kilo", Optional Genero As String = "M") As String Dim strUnidad(0 To 5) As String Dim strUnidades(0 To 5) As String Dim strCifras(0 To 4) As String Dim NumeroCifras As Byte Dim NumeroTercios As Byte Dim strNumero As String Dim strTMP As String Dim dblNumeroEntero As Double Dim intNumeroTmp As Integer Dim intCentavos As Integer Dim J As Integer Dim intNumTmp As Integer strUnidades(0) = " pesos m/cte": strUnidades(1) = " unidades": strUnidades(2) = " dolares": strUnidades(3) = " euros": strUnidades(4) = " " & Unidades: strUnidades(5) = "" strUnidad(0) = " peso m/cte": strUnidad(1) = " unidad": strUnidad(2) = " dolar": strUnidad(3) = " euro": strUnidad(4) = " " & Unidad: strUnidad(5) = "" strCifras(1) = "": strCifras(2) = " mil ": strCifras(3) = " millones ": strCifras(4) = " mil ": strCifras(0) = " millón " intCentavos = Int((Round(numero, 2) * 100) - (Int(numero) * 100)) dblNumeroEntero = Round(numero, 2) - (intCentavos / 100) strNumero = CStr(Abs(dblNumeroEntero)) NumeroCifras = Len(strNumero) NumeroTercios = Abs(Int(-NumeroCifras / 3)) Select Case dblNumeroEntero Case 0 strTMP = "cero" Case 1 If fmtoUnidad <> 5 Then strTMP = "un" strUnidades(fmtoUnidad) = strUnidad(fmtoUnidad) Else strTMP = "uno" End If If Genero <> "M" Then strTMP = "una" Case 2 To 999 strTMP = CLetrasS1(CLetrasS3(dblNumeroEntero, 1), Genero) Case 1000 strTMP = "mil" Case 1000000 strTMP = "un millón" Case 1000001 To 1999999 strCifras(3) = " millón " For J = NumeroTercios To 1 Step -1 intNumTmp = CLetrasS3(dblNumeroEntero, J) If intNumTmp <> 0 Then strTMP = strTMP & CLetrasS1(intNumTmp, Genero) & strCifras(J) Next J Case Else For J = NumeroTercios To 1 Step -1 intNumTmp = CLetrasS3(dblNumeroEntero, J) If intNumTmp <> 0 Then strTMP = strTMP & CLetrasS1(intNumTmp, Genero) & strCifras(J) Next J End Select If Right(strTMP, 9) = "millones " Then strTMP = Mid(strTMP, 1, (Len(strTMP) - 9)) & "millones de" If Right(strTMP, 6) = "millón" Then strTMP = Mid(strTMP, 1, (Len(strTMP) - 6)) & "millón de" strTMP = strTMP & strUnidades(fmtoUnidad) If intCentavos > 0 Then Select Case fmtoUnidad Case 0 strTMP = strTMP & " con " & CLetrasS1(intCentavos, Genero) & " centavos" Case 5 strTMP = strTMP & " punto " & CLetrasS1(intCentavos, Genero) End Select End If 'cambiar "un mil" o "una mil" por "mil" strTMP = Replace(strTMP, "una mil", "mil", , , vbTextCompare) strTMP = Replace(strTMP, "un mil", "mil", , , vbTextCompare) CLetras = strTMP End Function 'función que secundaria que calcula las decenas Private Function CLetrasS2(numero As Integer, Genero As String) As String Dim strUnidades(0 To 20) As String: Dim strDecenas(2 To 9) As String: Dim Unidades As Byte: Dim Decenas As Byte: Dim strTMP As String strUnidades(0) = "": strUnidades(2) = "dos": strUnidades(3) = "tres": strUnidades(4) = "cuatro": strUnidades(5) = "cinco": strUnidades(6) = "seis": strUnidades(7) = "siete": strUnidades(8) = "ocho": strUnidades(9) = "nueve": strUnidades(10) = "diez": strUnidades(11) = "once": strUnidades(12) = "doce": strUnidades(13) = "trece": strUnidades(14) = "catorce": strUnidades(15) = "quince": strUnidades(16) = "diez y seis": strUnidades(17) = "diez y siete": strUnidades(18) = "diez y ocho": strUnidades(19) = "diez y nueve": strUnidades(20) = "veinte" strDecenas(2) = "veinti": strDecenas(3) = "treinta": strDecenas(4) = "cuarenta": strDecenas(5) = "cincuenta": strDecenas(6) = "sesenta": strDecenas(7) = "setenta": strDecenas(8) = "ochenta": strDecenas(9) = "noventa" If Genero = "M" Then strUnidades(1) = "un" Else strUnidades(1) = "una" End If Decenas = Int(numero / 10) Unidades = Int(numero - (Decenas * 10)) Select Case numero Case 1 To 20 strTMP = strUnidades(numero) Case 21 To 29 strTMP = strDecenas(Decenas) & strUnidades(Unidades) Case 30 To 99 If (Decenas > 0) And (Unidades > 0) Then strTMP = strDecenas(Decenas) & " y " & strUnidades(Unidades) If (Decenas > 0) And (Unidades = 0) Then strTMP = strDecenas(Decenas) End Select CLetrasS2 = strTMP End Function 'Funcion secundaria que calcula las centenas Private Function CLetrasS1(numero As Integer, Genero As String) As String Dim strCentenas(1 To 9) As String: Dim Centenas As Byte: Dim strTMP As String: Dim intNumeroEntero As Integer intNumeroEntero = Int(numero) Centenas = Int(numero / 100) If Genero = "M" Then strCentenas(1) = "ciento": strCentenas(2) = "doscientos": strCentenas(3) = "trecientos": strCentenas(4) = "cuatrocientos": strCentenas(5) = "quinientos": strCentenas(6) = "seiscientos": strCentenas(7) = "setecientos": strCentenas(8) = "ochocientos": strCentenas(9) = "novecientos" Else strCentenas(1) = "ciento": strCentenas(2) = "doscientas": strCentenas(3) = "trecientas": strCentenas(4) = "cuatrocientas": strCentenas(5) = "quinientas": strCentenas(6) = "seiscientas": strCentenas(7) = "setecientas": strCentenas(8) = "ochocientas": strCentenas(9) = "novecientas" End If Select Case numero Case 0 To 99 strTMP = CLetrasS2(intNumeroEntero, Genero) Case 100 strTMP = "cien" Case 200, 300, 400, 500, 600, 700, 800, 900 strTMP = strCentenas(Centenas) Case Else strTMP = strCentenas(Centenas) & " " & CLetrasS2(Int(numero - (Centenas * 100)), Genero) End Select CLetrasS1 = strTMP End Function 'Funcion secundaria que saca un tres cifras del numero Private Function CLetrasS3(numero As Double, Tercio As Integer) As Integer Dim CadaCifra As Integer Dim OrdenInverso As Integer Dim intNumeroTmp As Integer Dim NombreCifra(1 To 12) As String OrdenInverso = Len(CStr(numero)) 'Borra la matriz For CadaCifra = 1 To 12: NombreCifra(CadaCifra) = "0": Next CadaCifra For CadaCifra = 1 To Len(CStr(numero)) NombreCifra(OrdenInverso) = Val(Mid(CStr(numero), CadaCifra, 1)) OrdenInverso = OrdenInverso - 1 Next CadaCifra intNumeroTmp = Val(NombreCifra((Tercio * 3)) & NombreCifra((Tercio * 3) - 1) & NombreCifra((Tercio * 3) - 2)) CLetrasS3 = intNumeroTmp End Function