Forum

Ποσό ολογράφως... - Από {giocha_}

Παιδιά χαίρετε...

Μήπως έχετε κάνα scriptaki σε VB 5.0 ή VB 6.0 το οποίο να μετατρέπει το ποσό σε κείμενο;

Π.χ. το 1567,87 να γραφεί ΧΙΛΙΑ ΠΕΝΤΑΚΟΣΙΑ ΕΞΗΝΤΑ ΕΠΤΑ ΕΥΡΩ και ΟΓΔΟΝΤΑ ΕΠΤΑ ΛΕΠΤΑ.

Έχω παιδευτεί τόσο πολύ και δεν μπορώ να βγάλω άκρη.

Απάντηση από:agrippas

Ένα γρήγορο πρόγραμμα που έφτιαξα (δεν ξέρω αν είναι ο πιο εύκολος τρόπος αλλά σίγουρα δουλεύει) είναι κάπως έτσι:

Option Explicit
Option Base 0
Private Sub Command1_Click()
Dim strArxikoPoso As Long
Dim lngPoso As Long
Dim strPoso As String
Dim strDecOnomata(2, 10) As String
Dim strIntOnomata(6, 10) As String
Dim i As Integer
strIntOnomata(1, 0) = ""
strIntOnomata(1, 1) = "ένα"
strIntOnomata(1, 2) = "δύο"
strIntOnomata(1, 3) = "τρία"
strIntOnomata(1, 4) = "τέσσερα"
strIntOnomata(1, 5) = "πέντε"
strIntOnomata(1, 6) = "έξι"
strIntOnomata(1, 7) = "επτά"
strIntOnomata(1, 8) = "οκτώ"
strIntOnomata(1, 9) = "εννιά"
strIntOnomata(2, 0) = ""
strIntOnomata(2, 1) = "δέκα"
strIntOnomata(2, 2) = "είκοσι"
strIntOnomata(2, 3) = "τριάντα"
strIntOnomata(2, 4) = "σαράντα"
strIntOnomata(2, 5) = "πενήντα"
strIntOnomata(2, 6) = "εξήντα"
strIntOnomata(2, 7) = "εβδομήντα"
strIntOnomata(2, 8) = "ογδόντα"
strIntOnomata(2, 9) = "ενενήντα"
strIntOnomata(3, 0) = ""
strIntOnomata(3, 1) = "εκατό"
strIntOnomata(3, 2) = "διακόσια"
strIntOnomata(3, 3) = "τριακόσια"
strIntOnomata(3, 4) = "τετρακόσια"
strIntOnomata(3, 5) = "πεντακόσια"
strIntOnomata(3, 6) = "εξακόσια"
strIntOnomata(3, 7) = "επτακόσια"
strIntOnomata(3, 8) = "οκτακόσια"
strIntOnomata(3, 9) = "ενιακόσια"
strIntOnomata(4, 0) = ""
strIntOnomata(4, 1) = "χίλια"
strIntOnomata(4, 2) = "δύο χιλιάδες"
strIntOnomata(4, 3) = "τρεις χιλιάδες"
strIntOnomata(4, 4) = "τέσσερις χιλιάδες"
strIntOnomata(4, 5) = "πέντε χιλιάδες"
strIntOnomata(4, 6) = "έξι χιλιάδες"
strIntOnomata(4, 7) = "επτά χιλιάδες"
strIntOnomata(4, 8) = "οκτώ χιλιάδες"
strIntOnomata(4, 9) = "εννιά χιλιάδες"
'symplhrwse ta ypoloipa
'gia dekades xiliadwn, ekatontades xiliadwn, klp
'ypotypwdhs elegxos gia sfalmata
'isws 8es na to kaneis kalytero, dhl. if isnumeric(text1.text) klp...
If Len(Text1.Text) > 0 Then strArxikoPoso = Replace(Text1.Text, ",", ".") Else strArxikoPoso = "0"
'proteinw na elegkseis an to lngposo einai megalytero apo tis times
'gia tis opoies exeis dwsei onomata sta arrays. an nai, exit sub me error
lngPoso = CLng(strArxikoPoso)
'stroggylopoihsh sta 2 dekadika pshfia
lngPoso = Round(lngPoso, 2)
'arxizoume ton elegxo:
'edw egw arxizw apo tis xiliades epeidh mexri xiliades exw symplhrwsei
'an eixes symplhrwsei mexri ekatommyria 8a arxizes apo ekatommyria.
'piase to skeptiko kai ftiakse ton kwdika gia ta ypoloipa
If lngPoso \ 1000 <> 0 Then strPoso = strIntOnomata(4, lngPoso \ 1000)
lngPoso = lngPoso - 1000 * Int(lngPoso / 1000)
'ekatontades
If lngPoso \ 100 <> 0 Then strPoso = strPoso & " " & strIntOnomata(3, lngPoso \ 100)
lngPoso = lngPoso - 100 * Int(lngPoso / 100)

'gia tis dekades kai tis monades kanw patenta:
If Not Right(CStr(Int(lngPoso)), 2) = 12 And Not Right(CStr(Int(lngPoso)), 2) = 11 And lngPoso \ 10 <> 0 Then
If lngPoso \ 10 <> 0 Then strPoso = strPoso & " " & strIntOnomata(2, lngPoso \ 10)
lngPoso = lngPoso - 10 * Int(lngPoso / 10)
strPoso = strPoso & " " & strIntOnomata(1, lngPoso)
ElseIf Right(CStr(Int(lngPoso)), 2) = 11 And (lngPoso \ 10) <> 0 Then
strPoso = strPoso & " ένδεκα"
ElseIf Right(CStr(Int(lngPoso)), 2) = 12 And (lngPoso \ 10) <> 0 Then
strPoso = strPoso & " δώδεκα"
ElseIf lngPoso \ 10 = 0 Then
strPoso = strPoso & " " & strIntOnomata(1, lngPoso)
End If
'kai vgazw to mexri twra apotelesma...
If strPoso = "" Or strPoso = " " Then strPoso = "μηδέν"
strPoso = strPoso & " ευρώ"
'psakse na vreis an sto strArxikoPoso yparxei "." kai tote vgale ta dekadika pshfia
'8a se voh8nhsei h parapanw patenta, einai sxedon idios kwdikas
'vgazoume to apotelesma:
Label1.Caption = strPoso
End Sub

Θα πρέπει να συμπληρώσεις τον κώδικα με τα δεκαδικά ψηφία και σύμφωνα με τα σχόλια που σου έχω κάνει. Sorry, δεν έχω το χρόνο να το τελειώσω.

Απάντηση από:agrippas

Οπ παράλειψη:

Η φόρμα έχει ένα command button (button1), ένα label (label1) και ένα text (text1).

Στη γραμμή

If Not Right(CStr(Int(lngPoso)), 2) = 12 And Not Right(CStr(Int(lngPoso)), 2) = 11 And lngPoso \ 10 <> 0 Then

άλλαξέ την καλύτερα με
If Not Right(CStr(Int(lngPoso)), 2) = "12" And Not Right(CStr(Int(lngPoso)), 2) = "11" And lngPoso \ 10 <> 0 Then

(όχι ότι είναι λάθος, αλλά μια και είναι strings)