Eiro summas pārveidošana vārdos, izmantojot Microsoft Excel

Eiro-Vardos
Rakstā pieejams macro funkcijas kods, kas pārveido naudas summas EUR vārdos latviešu valodā. Šobrīd internetā jau ir kaut kas latviskots atrodams, bet katrā no tiem ir savas nianses, kuras var traucēt, lai iegūtu precīzu rezultātu. Šobrīd izveidotie pārveidojumi darbojās līdz triljoniem un drošvien Latvijā ar to vajadzētu pietikt, bet tāpat aprakstīšu, kā to var pielāgot citām valūtām un viss kods ir pieejams un modificējams.

Par iedvesmu un bāzi kalpoja Microsoft vietnē atrodamais funkcijas kods, kuru pielāgoju latviešu valodas īpatnībām, padarīju ērtāku un pielāgoju aktuālajai valūtai eiro un centiem. Galu galā nācās iepazīties, kā tad valodnieki lēmuši par eiro un centu pierakstu, par ko vēlreiz pārliecinājos šeit.

Funkcija, kura izpilda pārveidojumus saucās EiroVardos.
Lejupielādēt to vari šeit dažādos veidos:
1. xls vai xlsm formā;
2. xla vai xlam formā kā programmu, kas tiek pievienota Excel;
3. vai arī iekopēt zemāk esošo kodu pēc instrukcijas.

Ja kaut kas nav kā tam vajadzētu būt, tad droši pievieno savu komentāru.
Nākošajā rakstā aprakstīšu dažādas iespējas, kā šādus vai citādākus macro kodu ērtāk izmantot savā ikdienas darbā.
Funkcija pielāgojama jebkurai citai valūtai, jo daļa, kas par to atbild ir šī te:
Select Case Eiro
Case “”
Eiro = “nulle eiro”
Case Else
Eiro = Eiro & ” eiro”
End Select
Select Case Cents
Case “”
Cents = ” un nulle centi”
Case “viens”
Cents = ” un viens cents”
Case Else
Cents = ” un ” & Cents & ” centi ”
End Select

Un šeit zemāk ir pilnībā visa funkcija, kuru var pievienot konkrētam failam šādi:
1. atrodoties attiecīgajā Excel failā ar kombināciju Alt + F11 jāatver Visual Basic logs;
2.jāizveido jauns modulis, kurā iekopē zemāk redzamo kodu.

Option Explicit
'Main Function
Function EiroVardos(ByVal MyNumber)
Dim Eiro, Cents, Temp
Dim DecimalPlace, Count
Dim value As Variant
ReDim Place(9) As String
Place(2) = " tūkstotis "
Place(3) = " miljons "
Place(4) = " miljards "
Place(5) = " triljons "

value = MyNumber.Cells(1, 1).value
If IsEmpty(MyNumber) = True Then
EiroVardos = ""
Exit Function
End If

MyNumber = Trim(Str(MyNumber))
DecimalPlace = InStr(MyNumber, ".")

If Val(MyNumber) >= 1E+15 Then
EiroVardos = "Skaitlis ir pārāk liels!"
Exit Function
End If

If DecimalPlace > 0 Then
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
"00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If

If (Len(MyNumber) > 4 And Mid(Right(MyNumber, 5), 1, 2) = "11") Or Mid(Right(MyNumber, 4), 1, 1) <> "1" Then Place(2) = " tūkstoši "
If (Len(MyNumber) > 7 And Mid(Right(MyNumber, 8), 1, 2) = "11") Or Mid(Right(MyNumber, 7), 1, 1) <> "1" Then Place(3) = " miljoni "
If (Len(MyNumber) > 10 And Mid(Right(MyNumber, 11), 1, 2) = "11") Or Mid(Right(MyNumber, 10), 1, 1) <> "1" Then Place(4) = " miljardi "
If (Len(MyNumber) > 13 And Mid(Right(MyNumber, 14), 1, 2) = "11") Or Mid(Right(MyNumber, 13), 1, 1) <> "1" Then Place(5) = " triljoni "

Count = 1
Do While MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp <> "" Then Eiro = Temp & Place(Count) & Eiro
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Eiro
Case ""
Eiro = "nulle eiro"
Case Else
Eiro = Eiro & " eiro"
End Select
Select Case Cents
Case ""
Cents = " un nulle centi"
Case "viens"
Cents = " un viens cents"
Case Else
Cents = " un " & Cents & " centi "
End Select

EiroVardos = Eiro & Cents
End Function

Function GetHundreds(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
' Convert the hundreds place.
If Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & " simti "
End If
If Mid(MyNumber, 1, 1) = "1" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & " simts "
End If
' Convert the tens and ones place.
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(MyNumber, 2))
Else
Result = Result & GetDigit(Mid(MyNumber, 3))
End If
GetHundreds = Result
End Function

Function GetTens(TensText)
Dim Result As String
Result = "" ' Null out the temporary function value.
If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
Select Case Val(TensText)
Case 10: Result = "desmit"
Case 11: Result = "vienpadsmit"
Case 12: Result = "divpadsmit"
Case 13: Result = "trīspadsmit"
Case 14: Result = "četrpadsmit"
Case 15: Result = "piecpadsmit"
Case 16: Result = "sešpadsmit"
Case 17: Result = "septiņpadsmit"
Case 18: Result = "astoņpadsmit"
Case 19: Result = "deviņpadsmit"
Case Else
End Select
Else ' If value between 20-99...
Select Case Val(Left(TensText, 1))
Case 2: Result = "divdesmit "
Case 3: Result = "trīsdesmit "
Case 4: Result = "četrdesmit "
Case 5: Result = "piecdesmit "
Case 6: Result = "sešdesmit "
Case 7: Result = "septiņdesmit "
Case 8: Result = "astoņdesmit "
Case 9: Result = "deviņdesmit "
Case Else
End Select
Result = Result & GetDigit _
(Right(TensText, 1)) ' Retrieve ones place.
End If
GetTens = Result
End Function

Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "viens"
Case 2: GetDigit = "divi"
Case 3: GetDigit = "trīs"
Case 4: GetDigit = "četri"
Case 5: GetDigit = "pieci"
Case 6: GetDigit = "seši"
Case 7: GetDigit = "septiņi"
Case 8: GetDigit = "astoņi"
Case 9: GetDigit = "deviņi"
Case Else: GetDigit = ""
End Select
End Function

8 komentāri Rakstīt komentāru

  1. Sveiks !

    Man neizdevās. Tiek uzrādīts, ka mainīgais nav definēts. Lai gan paņemot oriģinālo no MS lapas, viss sanāk.

  2. Jānis, paldies par Jūsu darbu! Bet šī funkcija nestrādā korekti mana failā (gālotnes un mikstīnājumi) Kad es izveidoju moduli un nokopēju kodu uz Visual Basic, tur kods nokopēts jau nekorekti((( Atvērot Jūsu failu no komentāri, arī tāda kļūda ((( Es esmu grāmatvedis, šī funkcija ir ļoti noderīga, bet es nesaprotu , kā man izlabot?

  3. Sveiki,

    Ja kādam ir problēmas ar latviešu burtiem, nepiesiešams samainīt “Current language for non-Unicode programms”. To var izdarīt: Control panel -> Clock, language and Region -> Region -> Administrative -> Change system locale

  4. Uz Windows viss strādā, bet OSX latviešu mīkstinājuma zīmes nestrādā, kāds varētu ieteikt kā OSX to var salabot?

  5. 397.51
    trоs simti deviтdesmit septiтi eiro un piecdesmit viens centi

    ar locījumiem ir problema un diakritiskiem zīmem.

Komentēt