Excel- Převod čísla na slovní vyjádření

[obcasny_navstevnik]

to ByTrit:
Opravit sklonovani podle pravidel slovenciny by mel nekdo znaly slovenciny.
Nejspis bude nutno pridat potrebne pole a pouzit je u prislusneho radu cisla.

[ByTrit]

no od 10miliónov hore by to malo vyzerat stale rovnako 11miliónov 12miliónov.... 23miliónov...namiesto toho ale napise 23milióny.. vedel by to niekto dorobit?

[Jandra]

Čau, perfektně funguje v Excelovské verzi do 2003. Potřeboval bych to rozchodit i ve verzi Excel 2007. Nenašel jsem tam možnost vložení nového modulu jako v předchozí verzi!

[obcasny_navstevnik]

?? V excelu Alt+F11>nabidka Insert>Module a mas vlozeny novy standardni modul. Do nej nakopiruj potrebnou verzi, zde je pripojena uzivatelska funkce generujici cislo slovy bez mezer, v Excelu 2007 funkcnost overena, bohuzel si budes muset opravit cestinu, forum pouziva jine kodovani nez editor VBA a exportovany modul VBA nelze pripojit:

Kód: Vybrat vše

Option Explicit

Function Slovy1(Cis) As String ' bez mezer mezi slovy
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 Not IsNumeric(Cis) Then Slovy1 = "Hodnota není èíslo!": Exit Function
  If Cis > 999999999 Then Slovy1 = "Hodnota>999 999 999!": Exit Function
'
  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", "dvasta", "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
  Rad = 0 ' rad cislice v cisle
  Slovy1 = ""
  Do
    pom = Mid(StrCis, Pol, 1)
    If Pol > 1 Then ' hodnota vyssiho radu nez aktualni
      pom1 = Mid(StrCis, Pol - 1, 1)
    Else ' hodnota pro nejvyssi aktualni rad
      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) & "milionù"): Ofs = IIf(pom1 <> 1, 1, 2)
      Case 7
        pom2 = Des(pom): Ofs = 1
      Case 8
        pom2 = Sta(pom): Ofs = 1
    End Select
'
    Slovy1 = pom2 & Slovy1
    Pol = Pol - Ofs: Rad = Rad + Ofs
'
  Loop While Pol > 0
  Slovy1 = Trim(Slovy1) ' & " " & Right(StrCis, 2) ' pridani destinne casti
End Function

v listu:

Kód: Vybrat vše

=Slovy1(A48)

[Jandra]

Zkusím ještě dnes, teď jsem vytížen jinak. Zatím velké díky za radu!

[Jandra]

Tak v Excelu 2007 již vše po opravě češtiny funguje!
Ještě jednou dík za pomoc!

[vforejt]

asi jsem nějak pomalejší, ale v Excelu 2007 mi to nefunguje. Udělal jsem všechno podle předchozích příspěvku ale pořád mi to hlásí chybu. Poraďte mi někdo, díky

[PaloPa]

asi jsem nějak pomalejší, ale v Excelu 2007 mi to nefunguje. Udělal jsem všechno podle předchozích příspěvku ale pořád mi to hlásí chybu. Poraďte mi někdo, díky

Neviem, či pomôže slovenská verzia, ktorú používam pre svoje programy (03 i 07) a funguje v pohode:

Príklad:
http://pc-prog.eu/phpBB3/images/xMyKB/Funkcia_Slovom.zip

(kód: ALT + F11)

Ak je použitý ako 4-tý parameter funkcie SLOVOM "cent" (resp "halier") prevedú sa do textovej podoby (aj správne vyskloňované).

Možno použiť aj iné koncovky (napr. "hal"), ale tie sa už neskloňujú.

Palo

[radekbrblos]

muzete me nekdo prosim poradit kde v excelu najdu kartu Vývojář > Visual Basic > Insert > Module predem diky.

[obcasny_navstevnik]

Google nabidne radove tisice temat, na prvnim miste:
http://office.microsoft.com/cs-cz/word- ... 73052.aspx
a jinak spustis editor VBA v Excelu (i 2007) klavesami Alt+F11

[emikus]

Dobrý den,
příspěvek mi hodně pomohl, děkuji. Jen jednu otázku, na kterou nemůžu přijít... Jak dodělat, aby za slovně vyjádřenou částkou se dopsal znak měny (Kč)? Napadlo mě pouze dopsat Kč za číslovky jedna, dva..., ale to neřeší situaci, když částka bude končit na celé sta nebo tisíce a tam už toto "řešení" použít nelze. Zároveň nechci mít měnu dopsanou až v další buňce. Chtěl bych dosáhnout toho, aby vždy byla hned za slovy vyjádřenou částkou.
V odkazu od PaloPa (http://pc-prog.eu/phpBB3/images/xMyKB/F ... Slovom.zip) to takto funguje, ale nejsem schopen to rozklíčovat.
Děkuji za typy...

[PaloPa]

VBA kód v mojej verzii nie je heslovaný, dá sa zobraziť cez ALT+F11.

Ak nevadí slovenčina, Kč sa dá vložiť do funkcie ako parameter (i haliere), viď obrázok,
inak je treba "črevá" funkcie počeštiť.

Palo

[obcasny_navstevnik]

Ve funkci:
Function Slovy1(Cis) As String ' bez mezer mezi slovy
uprav predposledni radek takto:
...
Slovy1 = Trim(Slovy1) & " Kč" ' & " " & Right(StrCis, 2) ' pridani destinne casti
End Function

Pokud potrebujes vlozit i desetinny oddelovac a 00 haleru, pak takto:
Slovy1 = Trim(Slovy1) & ",00 Kč"

[emikus]

Když se něco umí, tak je to nádhera. Děkuji oběma pánům za řešení...

[Somebodyx]

Lepší je, podle mě, nechat původní funkci tak jak je a jenom pro konkrétní použití v Excelu s ní naložit podle momentální potřeby standardním způsobem, jako s jakýmkoli jiným vzorečkem/funkcí.

Např. =slovy(A1)&"Kč"
nebo ="slovy "&velká2(slovy(A1))&" korun českých" atd.
až po např. ="slovy "&VELKÁ2(Slovy(A1))&" korun českých"&KDYŽ(ABS(A1-USEKNOUT(A1))*100>0;" a "&Slovy(ABS(A1-USEKNOUT(A1))*100)&" haléřů";"")
Fantazii se meze nekladou ...

(masochisti můžou místo & použít funkci concatenate, která dělá v principu to samé ... )

BTW, moc díky za původní kód, taky mi vytrh trn z paty ... jo a ještě tam je přebytečných pár mezer u tisíců a milionů v případě "teens" = 11100, 12013200 ap. - opraví si jistě každý sám.