![]() |
|
#1
|
|||
|
|||
![]()
You show no code or function here that will 'convert the numeric amount into words'
Are you using a UDF (user defined function), or calling from code ? Where is your code and/or function located ? For better responses you should attach a sample workbook, redacted as necessary. |
#2
|
|||
|
|||
![]()
This is the other code I use in the excel file and converts the numeric amount into words, but the code is written in Greek
Code:
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 Last edited by Pecoflyer; 08-07-2017 at 09:48 AM. |
![]() |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
Self Created OneNote page drops words when printing | AR_RonK | OneNote | 4 | 03-14-2018 08:12 AM |
![]() |
TDeVore | Word | 1 | 01-18-2017 09:06 PM |
![]() |
Captain | Word | 2 | 06-24-2016 09:10 AM |
Outlook Storage | dpslusser | Outlook | 1 | 08-23-2012 11:48 AM |
email storage by job | sgk18 | Outlook | 0 | 03-26-2012 06:23 PM |