ࡱ> \^[9 3bjbj.N l LmA@@@@@@@$#B CD@i@?'A???&@?@??@@ p$<\ 5 @@=A0mA@E?E@?Option Base 0 ' Ioannis Varlamis 2005,2007 Private Const zero As String = " " Function TextNumber(number As Variant, _ Optional NegativeText As String = "-", _ Optional IntGender As Integer = 3, _ Optional IntMeasurePlural As String, _ Optional IntMeasureSingular As String, _ Optional Separator As String = "", _ Optional DecCount As Integer = -1, _ Optional DecGender As Integer = 3, _ Optional DecMeasurePlural As String, _ Optional DecMeasureSingular As String, _ Optional DecNoZero As Boolean = False, _ Optional IntNoZero As Boolean = False, _ Optional NoSpace As Boolean = False) As String Application.Volatile True If Application.Version < 9 Then GoTo myEnd If IsDate(number) Then TextNumber = DateText(number) GoTo myEnd End If Select Case True Case VBA.IsEmpty(number): GoTo myEnd Case Not VBA.IsNumeric(number): TextNumber = CVErr(xlErrValue): GoTo myEnd Case Application.IsLogical(number): TextNumber = CVErr(xlErrValue): GoTo myEnd Case VBA.IsError(number): TextNumber = CVErr(xlErrValue): GoTo myEnd End Select Dim R(0 To 14) As Variant Dim HD As Variant Dim Y As Variant Dim numberDEC As Variant: numberDEC = number Dim M As Integer Dim j As Integer Dim IntPart As String Dim DecPart As String Dim dekata As String: dekata = "" Dim dekato As String: dekato = "" Dim sta As String: sta = "" Dim sto As String: sto = "" HD = VBA.Array("", "", _ "", "", _ " ", " ", _ "", " ", _ " ", "", _ " ", " ", _ "", " ", _ " ", " ") If Int(Abs(number)) = 1 And IntMeasureSingular <> "" _ Then IntMeasurePlural = IntMeasureSingular IntPart = IntText(number, NegativeText, IntGender) & IntMeasurePlural numberDEC = Abs(numberDEC) numberDEC = Format(numberDEC, "0.000000000000000") For j = 14 To 0 Step -1 R(j) = Mid(numberDEC, Len(numberDEC) - 14 + j, 1) Next numberDEC = VBA.Join(R, "") Select Case True Case DecCount = -1 And numberDEC = 0 DecCount = 0 DecMeasurePlural = "" DecMeasureSingular = "" Case DecCount = -1 And numberDEC <> 0 Y = numberDEC Do Y = Y / 10 M = M + 1 Loop While Y = Int(Y) DecCount = 15 - M + 1 DecMeasurePlural = "" DecMeasureSingular = "" DecGender = 3 End Select numberDEC = VBA.Left(numberDEC, DecCount) If numberDEC = 1 And DecMeasureSingular <> "" Then DecMeasurePlural = DecMeasureSingular Select Case True Case DecCount = 0 Case DecMeasurePlural <> "" DecPart = IntText(numberDEC, "", DecGender) & DecMeasurePlural Case DecMeasurePlural = "" DecPart = IntText(numberDEC, "", DecGender) & HD(DecCount) If numberDEC = 1 And DecMeasureSingular = "" Then DecPart = Replace(DecPart, dekata, dekato) DecPart = Replace(DecPart, sta, sto) End If End Select Separator = ChrW(32) & Separator & ChrW(32) If DecCount = 0 Then Separator = "" If DecNoZero = True Then If VBA.Left(DecPart, 5) = RTrim(zero) Then Separator = "": DecPart = "" End If If IntNoZero = True Then If IntPart = NegativeText & zero Then Separator = "": IntPart = NegativeText End If TextNumber = Application.WorksheetFunction.Trim(IntPart & Separator & DecPart) If NoSpace = True Then TextNumber = _ Application.WorksheetFunction.Substitute(TextNumber, " ", "") myEnd: End Function Private Function IntText(numberINT As Variant, _ Optional NegativeText As String = "-", _ Optional GenderINT As Integer = 3) As String Dim Tm As Variant Dim Am As Variant Dim Fm As Variant Dim tt As Variant Dim AFt As Variant Dim TAFd As Variant Dim Te As Variant Dim Ae As Variant Dim Fe As Variant Tm = VBA.Array("", " ", " ", " ", " ", _ " ", " ", " ", " ", " ") Am = VBA.Array("", " ", " ", " ", " ", _ " ", " ", " ", " ", " ") Fm = VBA.Array("", " ", " ", " ", " ", _ " ", " ", " ", " ", " ") tt = VBA.Array(" ", " ", " ", " ", " ", _ " ", " ", " ", " ", " ") AFt = VBA.Array(" ", " ", " ", " ", " ", _ " ", " ", " ", " ", " ") TAFd = VBA.Array("", " ", " ", " ", " ", _ " ", " ", " ", " ", " ") Te = VBA.Array("", " ", " ", " ", " ", _ " ", " ", " ", " ", " ") Ae = VBA.Array("", " ", " ", " ", " ", _ " ", " ", " ", " ", " ") Fe = VBA.Array("", " ", " ", " ", " ", _ " ", " ", " ", " ", " ") Dim ekato As String: ekato = " " Dim ekaton As String: ekaton = " " Dim Tx As String: Tx = " " Dim Ax As String: Ax = " " Dim Fx As String: Fx = " " Dim xx As String: xx = " " Dim mill As String: mill = "  " Dim mills As String: mills = " " Dim billion As String: billion = " " Dim trillion As String: trillion = " " Dim V(0 To 14) As Variant Dim apart As String, bpart As String, cpart As String Dim dpart As String, epart As String, totalpart As String Dim oSgn As Integer, oLen As Integer, i As Integer oSgn = Sgn(numberINT) numberINT = Abs(numberINT) numberINT = Format(numberINT, "0.000000000000000") numberINT = Int(numberINT) oLen = Len(numberINT) If oLen > 15 Then IntText = CVErr(xlErrValue): GoTo myEnd For i = 0 To oLen - 1 V(15 - oLen + i) = Mid(numberINT, i + 1, 1) Next If V(1) + V(2) = 0 Then Te(1) = ekato Select Case True Case V(0) + V(1) + V(2) = 0 Case V(1) = 1 epart = Te(V(0)) & tt(V(2)) & trillion Case Else epart = Te(V(0)) & TAFd(V(1)) & Tm(V(2)) & trillion End Select Te(1) = ekaton If V(5) + V(4) = 0 Then Te(1) = ekato Select Case True Case V(3) + V(4) + V(5) = 0 Case V(4) = 1 dpart = Te(V(3)) & tt(V(5)) & billion Case Else dpart = Te(V(3)) & TAFd(V(4)) & Tm(V(5)) & billion End Select Te(1) = ekaton If V(7) + V(8) = 0 Then Te(1) = ekato Select Case True Case V(6) + V(7) + V(8) = 0 Case V(6) + V(7) = 0 And V(8) = 1 cpart = mill Case V(7) = 1 cpart = Te(V(6)) & tt(V(8)) & mills Case Else cpart = Te(V(6)) & TAFd(V(7)) & Tm(V(8)) & mills End Select If GenderINT = 1 Then Tm = Am: tt = AFt: Te = Ae: Tx = Ax If GenderINT = 2 Then Tm = Fm: tt = AFt: Te = Fe: Tx = Fx Te(1) = ekaton If V(11) + V(10) = 0 Then Fe(1) = ekato Select Case True Case V(9) + V(10) + V(11) = 0 Case V(9) + V(10) = 0 And V(11) = 1 bpart = Tx Case V(10) = 1 bpart = Fe(V(9)) & AFt(V(11)) & xx Case Else bpart = Fe(V(9)) & TAFd(V(10)) & Fm(V(11)) & xx End Select Te(1) = ekaton If V(14) + V(13) = 0 Then Te(1) = ekato If V(13) = 1 Then apart = Te(V(12)) + tt(V(14)) _ Else: apart = Te(V(12)) & TAFd(V(13)) & Tm(V(14)) totalpart = epart & dpart & cpart & bpart & apart If numberINT = 0 Then totalpart = zero If oSgn = -1 Then NegativeText = NegativeText & " " Else NegativeText = "" IntText = NegativeText & totalpart myEnd: End Function Private Function DateText(mydate As Variant) As String Dim oday As Integer: oday = Day(mydate) Dim omonth As Integer: omonth = Month(mydate) Dim oyear As Integer: oyear = Year(mydate) Dim VMONTH As Variant VMONTH = VBA.Array("", "", "", "", _ "", "", "", "", _ "", "", "", _ "", "") DateText = IntText(oday, "", 2) & VMONTH(omonth) & ", " & IntText(oyear, "", 3) End Function 3CJXlD&4m  9 d { D 3  1 ^ o p , h 0* ")_d4JYt "-WX??^O^ij#$=FMZ  2EYntR.,Xj !!R""##*$j$j$$$4%%%8&&&.''(((6(i(((((() )!)G)X)x)))))****D*U*u***** + ++?+P+p++++++0,;,<,v,,,,,,,-C-V-i-------.O......+/,/O/V/c////60b0b00f11B2222333 ,1h. A!7"q#$%  i8@8 CJ_HaJmHsHtHFA@F   N,T}"[4m9d{D 1^o:;ZxY ?# ( D E V    8 R t   u $2nyz .itu(Tb+Sd EPQ`#$K-[ ] 0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000003 ? j$),b03 !"#$%&3 !,349:>?ABHT\]ghnoqry2:;MNPQWkst}~ &')*0DLM_`bci}  *+3489;<GHOTXY]^cdfgmntvz#&+,69=>CLPQ\]fgmpz}  #$%&()0145>?ABIKTW]^abcdfgnorstuwx "#%&,.158;=@CDI7B),>?FIPQWYegpt     # ' ( 1 4 7 8 < = > E K L P Q U Z ^ _ g m p q z     - . 1 2 H I L M ^ b c h i j m p q r |          ( - 0 1 C J N O _ b t u { |    * 1 4 ; < E K T X Z [ c q s t }       ! " % & , . 7 : > E N Q U Z \ ] e j n o x   !"&'07>AMNQRTV`c %&./67@ACDK[cdpqstz  !"&')*13679:<=DFIJLMOPWY\]_`bcjkmpstyFHKNOTGJMPQVbdgjkp145:;=>DFKWZ[abdekms  367<=?@FHM_bcjkmntv}   &(1245;<?@DEGHOQUVXY`bcdfgnptwz{ !&'1489>@CDEJLMQZ[aehimpqz|} #(,-1:?BDEFMQRSZ\]^emnqrxz| $()-6;>@ABIMNOVXYZahilmsuw}  058:;<CEFGNSX\]ajortuv}  $*+-./67@DEGMRSYZ^_chlmntu|}  !(,-.689:BDEHIOQSY_`bcdkluyz|  "$&'059:CFJKMNRX\]ilx  !$%+-0178:;BDJMRSY[^_deghoqvy}~  +,ST|!2Zk 3Dl}89cdzCL  01]^no9;Y^w|X] >?" # ' ( C E U Z ~   - 7 H Q ^ s |   t u   ! * d q   ! " , . Y Z }  MNTV  N[ 13DFWYjkEFFG$abCH01VW23^_;<np>@UZ#(1:mnxz$-6hisu '0SXaj*+RSch DEOQ_`"$JK,-Z[ 2 \ q VarlamisXC:\Documents and Settings\Varlamis Ioannis\Desktop\\Cod_NumberText_Function.doc@33 C33dkkk @@@@@ @$@@@P@@0UnknownGz Times New Roman5Symbol3& z Arial"qh!!!7r02Code_NumberTect_Function   excelIoannis VarlamisVarlamisOh+'0$ 8D ` l xCode_NumberTect_Function0odeIoannis Varlamisunc excelNormal  Varlamis2rlMicrosoft Word 9.0@@ G[@<\!՜.+,0  hp   Excel T Code_NumberTect_Function   !"#$%&')*+,-./0123456789:;<=>?@ABCDEFGHIJLMNOPQRTUVWXYZ]Root Entry F@7<\_1Table(EWordDocument.NSummaryInformation(KDocumentSummaryInformation8SCompObjmObjectPool@7<\@7<\  F Microsoft Word MSWordDocWord.Document.89q