Olografos_sto_word
Public Sub olografos()
Dim olografo As String
Dim arithmos
Set arithmos = Selection
olografo = HellasEuro(arithmos, 0, "(Αρνητικό Ποσό)")
Selection.TypeText Text:=olografo
End Sub
Private Function HellasEuro(EuroNumber As Variant, _
Optional byType As Integer = 0, _
Optional NegativeText As String) As String
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
On Error GoTo myEnd
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 = myTrim(Join(Array(Prosimo, _
Euro, " Ευρώ", Lepta)))
Case Abs(byType Mod 4) = 1
HellasEuro = myTrim(Join(Array(Prosimo, _
Euro, "και", Join(Array(V(9), V(10), "/100"), ""), "Ευρώ.")))
Case Abs(byType Mod 4) = 2
HellasEuro = myTrim(Join(Array(Prosimo, _
Euro, "Ευρώ και", Join(Array(V(9), V(10), " Λεπτά."), ""))))
Case Abs(byType Mod 4) = 3
If V(9) + V(10) = 0 Then
HellasEuro = myTrim(Join(Array(Prosimo, _
Euro, " Ευρώ.")))
Else
HellasEuro = myTrim(Join(Array(Prosimo, _
Euro, " Ευρώ", Lepta)))
End If
End Select
myEnd:
End Function
Private Function myTrim(strIn As String) As String
Dim one As String, two As String
one = ChrW(32)
two = one & one
strIn = Trim(strIn)
Do Until InStr(strIn, two) = 0
strIn = Replace(strIn, two, one)
Loop
myTrim = strIn
End Function
................
................
In order to avoid copyright disputes, this page is only a partial summary.
To fulfill the demand for quickly locating and searching documents.
It is intelligent file search solution for home and business.
Related download
- code numbertect function
- vba macros for solving problems in water chemistry
- creating and using an array with vba
- here are some tools that we find particularly useful
- brigham young university idaho
- this web page contains material for the computing an data
- olografos sto word
- brb arraytools user s manual
- business objects