Προς το περιεχόμενο

EXCEL Erotisi


picos

Προτεινόμενες αναρτήσεις

Δημοσ.

Το macro που ακολουθεί είναι μια συνάρτηση χρήστη που δίνεις ένα αριθμητικό ποσό και σου το μετατρέπει σε κείμενο ολογράφως σε δραχμές. Δεν δέχεται αρνητικά ποσά, ούτε δουλεύει με ποσά πάνω από 999.999.999<P>Option Base 1<P>Function DrachmasToText(amount)<BR> If amount < 0 Then<BR> DrachmasToText = "***ΑΡΝΗΤΙΚΟ ΠΟΣΟ***"<BR> Exit Function<BR> End If<BR> hmth = Int(amount / 100000000)<BR> tmth = Int((Int(amount) Mod 100000000) / 10000000)<BR> mth = Int((Int(amount) Mod 10000000) / 1000000)<BR> hth = Int((Int(amount) Mod 1000000) / 100000)<BR> tth = Int((Int(amount) Mod 100000) / 10000)<BR> th = Int((Int(amount) Mod 10000) / 1000)<BR> h = Int((Int(amount) Mod 1000) / 100)<BR> t = Int((Int(amount) Mod 100) / 10)<BR> o = Int((Int(amount) Mod 10))<BR> array1 = Array("Μια", "Δύο", "Τρεις", "Τέσσερις", "Πέντε", "Έξι", "Επτά", "Οκτώ", "Εννέα")<BR> array2 = Array("Δέκα", "Έντεκα", "Δώδεκα", "Δεκατρείς", "Δεκατέσσερις", "Δεκαπέντε", "Δεκαέξι", "Δεκαεπτά", "Δεκαοκτώ", "Δεκαεννέα")<BR> array3 = Array("", "Είκοσι", "Τριάντα", "Σαράντα", "Πενήντα", "Εξήντα", "Εβδομήντα", "Ογδόντα", "Ενενήντα")<BR> array4 = Array("Εκατό", "Διακόσιες", "Τριακόσιες", "Τετρακόσιες", "Πεντακόσιες", "Εξακόσιες", "Επτακόσιες", "Οκτακόσιες", "Εννιακόσιες")<BR> array5 = Array("Ένα", "Δύο", "Τρία", "Τέσσερα", "Πέντε", "Έξι", "Επτά", "Οκτώ", "Εννέα")<BR> array6 = Array("Εκατό", "Διακόσια", "Τριακόσια", "Τετρακόσια", "Πεντακόσια", "Εξακόσια", "Επτακόσια", "Οκτακόσια", "Εννιακόσια")<BR> array7 = Array("Δέκα", "Έντεκα", "Δώδεκα", "Δεκατρία", "Δεκατέσσερα", "Δεκαπέντε", "Δεκαέξι", "Δεκαεπτά", "Δεκαοκτώ", "Δεκαεννέα")<BR> If hmth = 0 Then<BR> part1m = ""<BR> Else<BR> part1m = array6(hmth) & " "<BR> End If<BR> If tmth = 0 Then<BR> part2m = ""<BR> ElseIf tmth = 1 Then<BR> part2m = array7(tmth + mth) & " "<BR> Else<BR> part2m = array3(tmth) & " "<BR> End If<BR> If mth = 0 Or tmth = 1 Then<BR> part3m = ""<BR> Else<BR> part3m = array5(mth) & " "<BR> End If<BR> If hmth = 0 And tmth = 0 And mth = 0 Then<BR> part4m = ""<BR> ElseIf hmth = 0 And tmth = 0 And mth = 1 Then<BR> part4m = "Εκατομμύριο "<BR> Else<BR> part4m = "Εκατομμύρια "<BR> End If<BR> If hth = 0 Then<BR> part1 = ""<BR> Else<BR> part1 = array4(hth) & " "<BR> End If<BR> If tth = 0 Then<BR> part2 = ""<BR> ElseIf tth = 1 Then<BR> part2 = array2(tth + th) & " "<BR> Else<BR> part2 = array3(tth) & " "<BR> End If<BR> If th = 0 Or tth = 1 Then<BR> part3 = ""<BR> ElseIf hth = 0 And tth = 0 And th = 1 Then<BR> part3 = "Χίλιες "<BR> Else<BR> part3 = array1(th) & " "<BR> End If<BR> If hth = 0 And tth = 0 And th = 0 Then<BR> part4 = ""<BR> ElseIf hth = 0 And tth = 0 And th = 1 Then<BR> part4 = ""<BR> Else<BR> part4 = "Χιλιάδες "<BR> End If<BR> If h = 0 Then<BR> part5 = ""<BR> Else<BR> part5 = array4(h) & " "<BR> End If<BR> If t = 0 Then<BR> part6 = ""<BR> ElseIf t = 1 Then<BR> part6 = array2(t + o) & " "<BR> Else<BR> part6 = array3(t) & " "<BR> End If<BR> If amount < 1 Then<BR> part7 = "Μηδέν "<BR> ElseIf o = 0 Or t = 1 Then<BR> part7 = ""<BR> Else<BR> part7 = array1(o) & " "<BR> End If<BR> If hmth = 0 And tmth = 0 And mth = 0 And hth = 0 And tth = 0 And th = 0 And h = 0 And t = 0 And o = 1 Then<BR> part8 = "Δραχμή"<BR> Else<BR> part8 = "Δραχμές"<BR> End If<BR> DrachmasToText = part1m & part2m & part3m & part4m & part1 & part2 & part3 & part4 & part5 & part6 & part7 & part8<BR>End Function

Αρχειοθετημένο

Αυτό το θέμα έχει αρχειοθετηθεί και είναι κλειστό για περαιτέρω απαντήσεις.

  • Δημιουργία νέου...