Excel Částka slovy - mezery
Dobrý den, chtěl bych požádat o radu ohledně kódu.
Function Slovy(Cis As Double) As String
Dim StrCis As String
Dim LenCis As Byte, Rad As Integer, Ofs As Byte
Dim Pol As Byte, pom As String, pom1 As String, pom2 As String
Dim Jedn As Variant, Des1 As Variant, Des As Variant, Sta As Variant
Dim JednTM As Variant, Tis As Variant, Mil As Variant
'
If IsEmpty(Cis) Then End
'
Jedn = Array("", "jedna", "dvě", "tři", "čtyři", _
"pět", "šest", "sedm", "osm", "devět")
Des1 = Array("deset", "jedenáct", "dvanáct", "třináct", "čtrnáct", _
"patnáct", "šestnáct", "sedmnáct", "osmnáct", "devatenáct")
Des = Array("", "", "dvacet", "třicet", "čtyřicet", "padesát", _
"šedesát", "sedmdesát", "osmdesát", "devadesát")
Sta = Array("", "jednosto", "dvěsta", "třista", "čtyřista", _
"pětset", "šestset", "sedmset", "osmset", "devětset")
Tis = Array("tisíc", "tisíc", "tisíce", "tisíce", "tisíce", _
"tisíc", "tisíc", "tisíc", "tisíc", "tisíc")
JednTM = Array("", "jeden", "dva", "tři", "čtyři", _
"pět", "šest", "sedm", "osm", "devět")
Mil = Array("milionů", "milion", "miliony", "miliony", "miliony", _
"milionů", "milionů", "milionů", "milionů", "milionů")
'
'
StrCis = CStr(Format(Cis, "0.00"))
Pol = InStr(StrCis, ",") - 1 ' poloha radu jednotek v cisle
If Pol > 9 Then Slovy = ">999 999 999": Exit Function
Rad = 0 ' rad cislice v cisle
Slovy = ""
Do
pom = Mid(StrCis, Pol, 1)
If Pol > 1 Then
pom1 = Mid(StrCis, Pol - 1, 1)
Else
pom1 = "0"
End If
'
Select Case Rad
Case 0
pom2 = IIf(pom1 <> 1, Jedn(pom), Des1(pom)): Ofs = IIf(pom1 <> 1, 1, 2)
Case 1
pom2 = Des(pom): Ofs = 1
Case 2
pom2 = Sta(pom): Ofs = 1
Case 3
pom2 = IIf(pom1 <> 1, JednTM(pom), Des1(pom)): Ofs = IIf(pom1 <> 1, 1, 2)
If Pol > 3 Then ' kdyz zustavaji jeste >3 cislice
If Mid(StrCis, Pol - 2, 3) <> "000" Then
pom2 = pom2 & IIf(pom1 <> 1, Tis(pom), " tisíc ") ' a jsou i tisice -> vlozeni slova tisic
Else
Ofs = 3 ' preskoci na rad 6 - miliony
End If
Else ' kdyz zustava jeste <3 cislice -> vlozeni slova tisic
pom2 = pom2 & IIf(pom1 <> 1, Tis(pom), " tisíc ")
End If
Case 4
pom2 = Des(pom): Ofs = 1
Case 5
pom2 = Sta(pom): Ofs = 1
Case 6
pom2 = IIf(pom1 <> 1, JednTM(pom) & Mil(pom), Des1(pom) & " milionu "): Ofs = IIf(pom1 <> 1, 1, 2)
Case 7
pom2 = Des(pom): Ofs = 1
Case 8
pom2 = Sta(pom): Ofs = 1
End Select
'
Slovy = pom2 & Slovy
Pol = Pol - Ofs: Rad = Rad + Ofs
'
Loop While Pol > 0
Slovy = Trim(Slovy) & " korun českých" ' & " " & Right(StrCis, 2) ' pridani destinne casti
End Function
tento kód napíše určenou částku slovy: jedentisícosmsetpadesátjedna korun českých
A chtěl bych aby to psalo: jeden tisíc osm set padesát jedna korun českých
Děkuji za Vaši pomoc