Suma žodžiu

2006-05-26 penktadienis 06:39:40

Siunčiu makrokomandą, kuri OpenOffice.org Calc programoje sumą skaičiais paverčia suma žodžiais.

INSTALIAVIMAS

1) Paleisti OpenOffice.Org Calc programą;
2) Eiti į PRIEMONĖS -> MAKROKOMANDOS -> TVARKYTI MAKROKOMANDAS -> OPENOFFICE.ORG BASIC ...
3) Spausti mygtuką NAUJAS
4) Atsidariusiame lange įkopijuoti makrokomandos turinį (makrokomandos tekstą žr.žemiau).
5) Spausti FAILAS -> ĮRAŠYTI
6) Spausti FAILAS -> UŽVERTI

TESTAVIMAS

1) Paleisti OpenOffice.Org Calc programą;
2) Langelyje A1 įrašykite skaičių 622057,91 ir spauskite ENTER
3) Langelyje A2 įrašykite =SUMLT(A1) ir spauskite ENTER
4) Jei viską teisingai atlikote, langelyje A2 turi atsirasti:
Šeši šimtai dvidešimt du tūkstančiai penkiasdešimt septyni litai 91 ct

'=======MAKROKOMANDOS TEKSTAS========

Function SumLT(NumberArg As Double, intCase As Integer) As String

'*----------------------------
' Funkcijos reikšmė – suma žodžiais.
'*----------------------------

Dim strSuma As String
Dim strMillions As String
Dim strThousands As String
Dim strHundreds As String
Dim m1 As String
Dim m2 As String
Dim t1 As String
Dim t2 As String
Dim r1 As String
Dim r2 As String
Dim v As String
Dim d As String
Dim strRez As String

strSuma = Format(NumberArg, "000,000,000.00" )
strMillions = Mid(strSuma, 1, 3)
strThousands = Mid(strSuma, 5, 3)
strHundreds = Mid(strSuma, 9, 3)
If NumberArg < 1 Then
strRez = "nulis litų "
GoTo pabaiga
End If

If strMillions <> "000" Then
m1 = TrysSkaitmenys(strMillions)
d = Mid(strMillions, 2, 1)
v = Right(strMillions, 1)
Select Case d
Case "1"
m2 = "milijonų "
Case Else
Select Case v
Case "0"
m2 = "milijonų "
Case "1"
m2 = "milijonas "
Case Else
m2 = "milijonai "
End Select
End Select
End If
If strThousands <> "000" Then
t1 = TrysSkaitmenys(strThousands)
d = Mid(strThousands, 2, 1)
v = Right(strThousands, 1)
Select Case d
Case "1"
t2 = "tūkstančių "
Case Else
Select Case v
Case "0"
t2 = "tūkstančių "
Case "1"
t2 = "tūkstantis "
Case Else
t2 = "tūkstančiai "
End Select

End Select
End If

r1 = TrysSkaitmenys(strHundreds)
d = Mid(strHundreds, 2, 1)
v = Right(strHundreds, 1)
Select Case d
Case "1"
r2 = "litų "
Case Else
Select Case v
Case "0"
r2 = "litų "
Case "1"
r2 = "litas "
Case Else
r2 = "litai "
End Select
End Select

strRez = m1 + m2 + t1 + t2 + r1 + r2 + " "

pabaiga:

SumLT = UCase(Left(strRez, 1)) + LCase(Mid(strRez, 2)) + Right(strSuma, 2) + " ct"

End Function

Private Function TrysSkaitmenys(strNum3 As String) As String

Dim s1 As String * 1 'šimtai
Dim d1 As String * 1 'dešimtys
Dim d2 As String * 2 'dešimtys ir vienetai
Dim v1 As String * 1 'vienetai
Dim s3 As String
Dim d3 As String
Dim v3 As String

s1 = Left(strNum3, 1)
d1 = Mid(strNum3, 2, 1)
d2 = Mid(strNum3, 2, 2)
v1 = Right(strNum3, 1)

Select Case s1
Case "1"
s3 = "vienas šimtas "
Case "2"
s3 = "du šimtai "
Case "3"
s3 = "trys šimtai "
Case "4"
s3 = "keturi šimtai "
Case "5"
s3 = "penki šimtai "
Case "6"
s3 = "šeši šimtai "
Case "7"
s3 = "septyni šimtai "
Case "8"
s3 = "aštuoni šimtai "
Case "9"
s3 = "devyni šimtai "
End Select
Select Case d1

Case "1"
Select Case d2
Case "10"
d3 = "dešimt "
Case "11"
d3 = "vienuolika "
Case "12"
d3 = "dvylika "
Case "13"
d3 = "trylika "
Case "14"
d3 = "keturiolika "
Case "15"
d3 = "penkiolika "
Case "16"
d3 = "šešiolika "
Case "17"
d3 = "septyniolika "
Case "18"
d3 = "aštuoniolika "
Case "19"
d3 = "devyniolika "
End Select
Case "2"
d3 = "dvidešimt "
Case "3"
d3 = "trisdešimt "
Case "4"
d3 = "keturiasdešimt "
Case "5"
d3 = "penkiasdešimt "
Case "6"
d3 = "šešiasdešimt "
Case "7"
d3 = "septyniasdešimt "
Case "8"
d3 = "aštuoniasdešimt "
Case "9"
d3 = "devyniasdešimt "
End Select
If d1 <> "1" Then
Select Case v1
Case "1"
v3 = "vienas "
Case "2"
v3 = "du "
Case "3"
v3 = "trys "
Case "4"
v3 = "keturi "
Case "5"
v3 = "penki "
Case "6"
v3 = "šeši "
Case "7"
v3 = "septyni "
Case "8"
v3 = "aštuoni "
Case "9"
v3 = "devyni "
End Select
End If
TrysSkaitmenys = s3 + d3 + v3
End Function

2014-09-19 penktadienis 11:59:08