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

αυτόματη γραφή ενός αριθμού σε μορφή ολογράφως


mike841

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

Δημοσ.

Παιδιά γειά σας.

Μήπως ξέρει κανείς αν υπάρχει τρόπος να μετατρέπεται αυτόματα στο excel ένας αριθμός από την γραφή με ψηφία στην γραφή του με λέξεις (ολογράφως); π.χ. 523 σε πεντακόσια είκοσι τρία.

Δημοσ.

Μάλλον αυτό ψάχνεις...

 

http://www.gigenis.freegr.net/temp/Numberwriter.zip

 

Καλείς τη "Function EURW" γράφοντας το =EURW(Α1)

 

Όπου Α1 γράφεις το κελί με τον αριθμό που θέλεις να μετατρέψεις

 

Υπάρχει μέσα και η "Function CYPW" για Κυπριακές Λίρες

  • 1 μήνα μετά...
Δημοσ.

Τώρα είδα το thread και βάζω παρακάτω την απάντηση που έστειλα στον φίλο mike841 στο pm που μου έστειλε, και για όποιον άλλο θέλει να το χρησιμοποιήσει. Και μια διευκρίνηση που δεν έγραψα στο pm: δεν δουλεύει με αρνητικά ποσά, αλλά μπορεί κανείς, αν έχει αρνητικό ποσό να χρησιμοποιήσει την συνάρτηση

 

="μείον "&CurrencyToText(ABS(F4))&"ευρώ και "&CurrencyToText(ROUND(MOD(ABS(F4)*100;100);0))&"λεπτά"

 

ή όπως αλλοιώς το προτιμά!

 

Φίλε nk13

Είδα ότι έχεις ασχοληθεί με τη μετατροπή ενός αριθμού από μορφή ψηφίων σε μορφή ολογράφως. Βρήκα τη μακροεντολή που έχεις παραθέσει στο forum της INSOMNIA στις 4-3-01' date=' προσπάθησα να την εισάγω στο Excel αλλά δεν τα κατάφερα. Μήπως μπορείς να μου δώσεις επιπλέον πληροφορίες για το πως μπορώ να το κάνω. Θα σου ήμουν ευγνώμων. Τη χρειάζομαι πολύ αυτή τη διαδικασία στη δουλειά μου.

Ευχαριστώ.[/quote']

 

Sorry φίλε mike841 για την καθυστέρηση, αλλά σήμερα είδα το μήνυμα σου. Λοιπόν, γυρνάς σε VBA με Alt-F11 και κάνεις Insert module και paste το παρακάτω:

 

Option Base 1

 

Function CurrencyToText(curamount)

If curamount < 0 Then

CurrencyToText = "***ΑΡΝΗΤΙΚΟ ΠΟΣΟ***"

Exit Function

End If

curhmth = Int(curamount / 100000000)

curtmth = Int((Int(curamount) Mod 100000000) / 10000000)

curmth = Int((Int(curamount) Mod 10000000) / 1000000)

curhth = Int((Int(curamount) Mod 1000000) / 100000)

curtth = Int((Int(curamount) Mod 100000) / 10000)

curth = Int((Int(curamount) Mod 10000) / 1000)

curh = Int((Int(curamount) Mod 1000) / 100)

curt = Int((Int(curamount) Mod 100) / 10)

curo = Int((Int(curamount) Mod 10))

curarray1 = Array("μια", "δύο", "τρεις", "τέσσερις", "πέντε", "έξι", "επτά", "οκτώ", "εννέα")

curarray2 = Array("δέκα", "έντεκα", "δώδεκα", "δεκατρείς", "δεκατέσσερις", "δεκαπέντε", "δεκαέξι", "δεκαεπτά", "δεκαοκτώ", "δεκαεννέα")

curarray3 = Array("", "είκοσι", "τριάντα", "σαράντα", "πενήντα", "εξήντα", "εβδομήντα", "ογδόντα", "ενενήντα")

curarray4 = Array("εκατό", "διακόσιες", "τριακόσιες", "τετρακόσιες", "πεντακόσιες", "εξακόσιες", "επτακόσιες", "οκτακόσιες", "εννιακόσιες")

curarray5 = Array("ένα", "δύο", "τρία", "τέσσερα", "πέντε", "έξι", "επτά", "οκτώ", "εννέα")

curarray6 = Array("εκατό", "διακόσια", "τριακόσια", "τετρακόσια", "πεντακόσια", "εξακόσια", "επτακόσια", "οκτακόσια", "εννιακόσια")

curarray7 = Array("δέκα", "έντεκα", "δώδεκα", "δεκατρία", "δεκατέσσερα", "δεκαπέντε", "δεκαέξι", "δεκαεπτά", "δεκαοκτώ", "δεκαεννέα")

If curhmth = 0 Then

part1m = ""

Else

part1m = curarray6(curhmth) & " "

End If

If curtmth = 0 Then

part2m = ""

ElseIf curtmth = 1 Then

part2m = curarray7(curtmth + curmth) & " "

Else

part2m = curarray3(curtmth) & " "

End If

If curmth = 0 Or curtmth = 1 Then

part3m = ""

Else

part3m = curarray5(curmth) & " "

End If

If curhmth = 0 And curtmth = 0 And curmth = 0 Then

part4m = ""

ElseIf curhmth = 0 And curtmth = 0 And curmth = 1 Then

part4m = "εκατομμύριο "

Else

part4m = "εκατομμύρια "

End If

If curhth = 0 Then

part1 = ""

Else

part1 = curarray4(curhth) & " "

End If

If curtth = 0 Then

part2 = ""

ElseIf curtth = 1 Then

part2 = curarray2(curtth + curth) & " "

Else

part2 = curarray3(curtth) & " "

End If

If curth = 0 Or curtth = 1 Then

part3 = ""

ElseIf curhth = 0 And curtth = 0 And curth = 1 Then

part3 = "χίλια "

Else

part3 = curarray1(curth) & " "

End If

If curhth = 0 And curtth = 0 And curth = 0 Then

part4 = ""

ElseIf curhth = 0 And curtth = 0 And curth = 1 Then

part4 = ""

Else

part4 = "χιλιάδες "

End If

If curh = 0 Then

part5 = ""

Else

part5 = curarray6(curh) & " "

End If

If curt = 0 Then

part6 = ""

ElseIf curt = 1 Then

part6 = curarray7(curt + curo) & " "

Else

part6 = curarray3(curt) & " "

End If

If curamount < 1 Then

part7 = "μηδέν "

ElseIf curo = 0 Or curt = 1 Then

part7 = ""

Else

part7 = curarray5(curo) & " "

End If

CurrencyToText = part1m & part2m & part3m & part4m & part1 & part2 & part3 & part4 & part5 & part6 & part7

End Function

 

Αυτό είναι μια user-defined συνάρτηση, οπότε στο Excel, από το μενού Εισαγωγή επιλέγεις Συνάρτηση και θα τη βρεις στην ομάδα συναρτήσεων user-defined ως CurrencyToText().

 

Εγώ για να μου βγάλει και τα δεκαδικά (τα σεντς ή λεπτά ή ότι άλλο θες) βάζω την εξής συνάρτηση:

 

=CurrencyToText(F4)&"ευρώ και "&CurrencyToText(ROUND(MOD(F4*100;100);0))&"λεπτά"

 

οπότε αν το κελί F4 έχει την τιμή 123,45, μου δίνει "εκατό είκοσι τρία ευρώ και σαράντα πέντε λεπτά". Φυσικά, μπορείς να αλλάξεις τα ευρώ και τα λεπτά σε ότι άλλο θέλεις.

 

Την συνάρτηση αυτή την χρησιμοποιώ κατά κόρον στην δουλειά μου. Αρχικά την είχα φτιάξει ώστε να βγάζει από μόνη της το "δραχμές", αλλά με την έλευση του ευρώ και των δεκαδικών/λεπτών, η παραπάνω συνάρτηση επίσης μου κάνει δουλειά πολύ απλά. Αν χρειαστείς κάτι άλλο και μπορώ να βοηθήσω, στην διάθεση σου.

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

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

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