HellasEuroVBACode - Excel Λύσεις



Option Explicit

Function HellasEuro(EuroNumber As Variant, _

Optional byType As Integer = 0, _

Optional NegativeText As String = "(Αρνητικό Ποσό)") As String

'© Γιάννης Χ. Βαρλάμης 2002

Application.Volatile True

Dim V(0 To 10)

Dim MONADES As Variant

Dim TEEN As Variant

Dim DEKADES As Variant

Dim EKATONTADES As Variant

Dim FMONADES As Variant

Dim FTEEN As Variant

Dim FEKATONTADES As Variant

Dim LE As String

Dim LD As String

Dim m As String

Dim d As String

Dim e As String

Dim x As String

Dim dx As String

Dim ex As String

Dim mir As String

Dim dmir As String

Dim emir As String

Dim Prosimo As String

Dim Lepta As String

Dim Euro As String

Dim Except As String

Dim p As Double

Dim q As Integer

Dim i As Integer

Select Case True

Case VBA.IsEmpty(EuroNumber): GoTo myEnd

Case Not VBA.IsNumeric(EuroNumber): HellasEuro = CVErr(xlErrValue): GoTo myEnd

Case Application.IsLogical(EuroNumber): GoTo myEnd

Case VBA.IsDate(EuroNumber): GoTo myEnd

Case VBA.IsError(EuroNumber): HellasEuro = CVErr(xlErrValue):: GoTo myEnd

End Select

MONADES = VBA.Array("", "Ένα", "Δύο", "Τρία", "Τέσσερα", _

"Πέντε", "Έξι", "Επτά", "Οκτώ", "Εννέα")

TEEN = VBA.Array("Δέκα", "Έντεκα", "Δώδεκα", "Δεκατρία", "Δεκατέσσερα", _

"Δεκαπέντε", "Δεκαέξι", "Δεκαεπτά", "Δεκαοκτώ", "Δεκαεννέα")

DEKADES = VBA.Array("", "Δέκα", "Είκοσι", "Τριάντα", "Σαράντα", _

"Πενήντα", "Εξήντα", "Εβδομήντα", "Ογδόντα", "Ενενήντα")

EKATONTADES = VBA.Array("", "Εκατόν", "Διακόσια", "Τριακόσια", "Τετρακόσια", _

"Πεντακόσια", "Εξακόσια", "Επτακόσια", "Οκτακόσια", "Εννιακόσια")

FMONADES = VBA.Array("", "Μία", "Δύο", "Τρεις", "Τέσσερις", _

"Πέντε", "Έξι", "Επτά", "Οκτώ", "Εννέα")

FTEEN = VBA.Array("Δέκα", "Έντεκα", "Δώδεκα", "Δεκατρείς", "Δεκατέσσερις", _

"Δεκαπέντε", "Δεκαέξι", "Δεκαεπτά", "Δεκαοκτώ", "Δεκαεννέα")

FEKATONTADES = VBA.Array("", "Εκατόν", "Διακόσιες", "Τριακόσιες", "Τετρακόσιες", _

"Πεντακόσιες", "Εξακόσιες", "Επτακόσιες", "Οκτακόσιες", "Εννιακόσιες")

If Sgn(EuroNumber) = -1 Then Prosimo = NegativeText Else Prosimo = ""

EuroNumber = Abs(EuroNumber)

p = Int(EuroNumber)

EuroNumber = Int((EuroNumber + 0.005) * 100)

For i = 0 To Len(EuroNumber) - 1

V(11 - Len(EuroNumber) + i) = Mid(EuroNumber, i + 1, 1)

Next i

If V(9) = 1 Then LE = "" Else LE = MONADES(V(10))

If V(9) = 1 Then LD = TEEN(V(10)) Else LD = DEKADES(V(9))

If V(7) = 1 Then m = "" Else m = MONADES(V(8))

If V(7) = 1 Then d = TEEN(V(8)) Else d = DEKADES(V(7))

If V(7) + V(8) = 0 Then EKATONTADES(1) = "Εκατό"

e = EKATONTADES(V(6))

EKATONTADES(1) = "Εκατόν"

If V(4) = 1 Then x = "" Else x = FMONADES(V(5))

If V(4) = 1 Then dx = FTEEN(V(5)) Else dx = DEKADES(V(4))

If V(4) + V(5) = 0 Then FEKATONTADES(1) = "Εκατό"

ex = FEKATONTADES(V(3))

FEKATONTADES(1) = "Εκατόν"

If V(1) = 1 Then mir = "" Else mir = MONADES(V(2))

If V(1) = 1 Then dmir = TEEN(V(2)) Else dmir = DEKADES(V(1))

If V(1) + V(2) = 0 Then EKATONTADES(1) = "Εκατό"

emir = EKATONTADES(V(0))

EKATONTADES(1) = "Εκατόν"

If V(9) = 0 And V(10) = 1 Then

Lepta = " και Ένα Λεπτό."

ElseIf V(9) + V(10) = 0 Then

Lepta = " και Μηδέν Λεπτά."

Else

Lepta = Join(Array(" και", LD, LE, "Λεπτά."))

End If

Select Case p

Case 0

Euro = "Μηδέν"

Case 1 To 999

Euro = Join(Array(e, d, m))

Case 1000 To 1999

Euro = Join(Array("Χίλια", e, d, m))

Case 2000 To 999999

Euro = Join(Array(ex, dx, x, "Χιλιάδες", e, d, m))

Case 1000000 To 1999999

If V(3) + V(4) + V(5) = 0 Then

Euro = Join(Array("Ένα Εκατομμύριο", e, d, m))

ElseIf V(3) + V(4) = 0 And V(5) = 1 Then

Euro = Join(Array("Ένα Εκατομμύριο", "Χίλια", e, d, m))

Else

Euro = Join(Array("Ένα Εκατομμύριο", ex, dx, x, "Χιλιάδες", _

e, d, m))

End If

Case 2000000 To 999999999

If V(3) + V(4) + V(5) = 0 Then

Euro = Join(Array(emir, dmir, mir, "Εκατομμύρια", e, d, m))

ElseIf V(3) + V(4) = 0 And V(5) = 1 Then

Euro = Join(Array(emir, dmir, mir, "Εκατομμύρια", "Χίλια", _

e, d, m))

Else

Euro = Join(Array(emir, dmir, mir, "Εκατομμύρια", _

ex, dx, x, "Χιλιάδες", e, d, m))

End If

End Select

Select Case True

Case byType Mod 4 = 0

HellasEuro = Application.Trim(Join(Array(Prosimo, _

Euro, " Ευρώ", Lepta)))

Case Abs(byType Mod 4) = 1

HellasEuro = Application.Trim(Join(Array(Prosimo, _

Euro, "και", Join(Array(V(9), V(10), "/100"), ""), "Ευρώ.")))

Case Abs(byType Mod 4) = 2

HellasEuro = Application.Trim(Join(Array(Prosimo, _

Euro, "Ευρώ και", Join(Array(V(9), V(10), " Λεπτά."), ""))))

Case Abs(byType Mod 4) = 3

If V(9) + V(10) = 0 Then

HellasEuro = Application.Trim(Join(Array(Prosimo, _

Euro, " Ευρώ.")))

Else

HellasEuro = Application.Trim(Join(Array(Prosimo, _

Euro, " Ευρώ", Lepta)))

End If

End Select

myEnd:

End Function

................
................

In order to avoid copyright disputes, this page is only a partial summary.

Google Online Preview   Download