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

Programy pro práci s textem, tabulkami, prezentacemi

Moderátor: Moderátoři Živě.cz

Odeslat příspěvekod d4d1k 18. 6. 2008 13:32

Ahojky, řeším jeden problém v excelu a sice jestli umí převést číslo na slovní vyjádření.
Potřeboval bych, aby k číslu zapsanému v jedné buňce jako číslo se automaticky vytvářelo jeho slovní vyjádření ve druhé buňce.

Příklad: A1= 253
B1= dvěstěpadesáttři

Pokud změním číslo v buňce A1, změní se i slovní vyjádření příslušného čísla v buňce B1.

Existuje na to v Excelu nějaká funkce? Já jsem na to bohužel nepřišel.
Pokud mi někdo poradíte, budu velmi vděčný.

Díky moc
d4d1k
Kolemjdoucí

Odeslat příspěvekod Marek Lutonský 18. 6. 2008 13:50

Funkce na tohle neexistuje. Vzhledem k tomu, že čeština skloňuje a v různých případech mají číslovky různé tvary, bylo by asi docela komplikované něco takového vytvořit. Určitě by to ale šlo.

Resp. v jakém rozsahu se ta čísla pohybují? Jaké je nejmenší a největší možné? Jestli jich není moc, tak by se jednoduše v druhém listu ke každému číslu napsalo jeho slovní vyjádření a funkcí Svyhledat by se k číselnému vyjádření hledalo příslušné slovo.
Marek Lutonský
Hlavní administrátor
Uživatelský avatar

Odeslat příspěvekod obcasny_navstevnik 18. 6. 2008 17:52

funkce ve VBA pro prevod na slovni vyjadreni, vlozit do modulu, pak ve vlastnich funkcich.

pripadne uprav - odstran mezery (forum nejak v retezcich mrsi diakritiku):

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("", "jedno sto ", "dva sta ", "tøi sta ", "ètyøi sta ", _
"pìt set ", "šest set ", "sedm set ", "osm set ", "devìt set ")
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) & " milionù "): 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) ' & " " & Right(StrCis, 2) ' pridani destinne casti
End Function
obcasny_navstevnik
Junior

Odeslat příspěvekod d4d1k 19. 6. 2008 00:18

Děkuji moc za pomoc, tohle je přesně to co jsem potřeboval!
Odstranil jsem mezery, opravil diakritiku a teď to šlape jako hodinky (o:

Kdyby to někdo někdy ještě potřeboval, házím upravený kód:

V Excelu na Kartu Vývojář > Visual Basic > Insert > Module (do okna pak vložit text níže)
Funkci vyvoláte přes vlastní funkce nebo zápisem: =slovy(odkaz na buňku s číslem nebo číslo)

Kód: Vybrat vše
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) ' & " " & Right(StrCis, 2) ' pridani destinne casti
End Function


Velké díky obcasny_navstevniku ;-)
d4d1k
Kolemjdoucí

Odeslat příspěvekod vlkousek 8. 7. 2008 14:06

Velké díky oběma. Mám kacířskou otázku, dalo by se něco takového provést i ve Wordu?
vlkousek
Junior
Uživatelský avatar

Odeslat příspěvekod obcasny_navstevnik 8. 7. 2008 15:22

nic tomu nebrani, jen tak prvotni navrh a zjednodusene:

Do dokumentu vlozit z ovladacich prvku TextBox.
Vyse uvedenou funkci vlozit v editoru VBA do modulu s upravami:

Function Slovy(Cis As Variant) As String
...
radek:
If IsEmpty(Cis) Then End
nahradit:

If Not IsNumeric(Cis) Then Slovy = "Err": Exit Function

Do objektu MS Word ThisDocument vlozit udalostni proceduru, napr. pro dvojklik na Textbox po vlozeni cisla:
Kód: Vybrat vše
Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Selection.EndKey Unit:=wdLine
Selection.TypeText Text:=vbTab & Slovy(TextBox1.Value)
End Sub


a upravit ji do pozadovane podoby.
obcasny_navstevnik
Junior

Odeslat příspěvekod vlkousek 11. 7. 2008 21:07

Díky moc. Jsi fakt machr, Občasný návštěvníku.
vlkousek
Junior
Uživatelský avatar

Odeslat příspěvekod neveceral 14. 9. 2008 20:00

jsem amatér, umím si pouze nahrát makro :potichu , nešlo by vysvětlit i pro mě, jak na to? Nešlo by to upravit, že by se označilo číslo a přes "nějaké" tlačítko se číslo převedlo na text? Díky.
neveceral
Junior
Uživatelský avatar

Odeslat příspěvekod obcasny_navstevnik 15. 9. 2008 10:48

do dokumentu v editoru VBA vloz do modulu nasledujici:

Kód: Vybrat vše
Option Explicit

Sub Prevod()
Dim txt As String

txt = Selection.Text
If IsNumeric(txt) Then MsgBox Slovy1(txt)
End Sub

Function Slovy1(Cis) 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 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
      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) & "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


subrutine Prevod (uprav si dle potreby) prirad klavesovou zkratku (postup v napovede)
vyber cislo, stiskni klavesovou zkratku
obcasny_navstevnik
Junior

Odeslat příspěvekod neveceral 15. 9. 2008 20:39

super, děkuji, má to ale malou chybku, číslo slovy se nenapíše do dokumentu, ale pouze se rozbrazí ve zprávě
http://img225.imageshack.us/my.php?image=beznzvuxi6.jpg
neveceral
Junior
Uživatelský avatar

Odeslat příspěvekod obcasny_navstevnik 15. 9. 2008 22:01

to je tak velky problem upravit subrutinu?

Kód: Vybrat vše
Sub Prevod()
Dim txt As String
  txt = Selection.Text
  If IsNumeric(txt) Then
    'MsgBox Slovy1(txt)
    Selection.MoveRight
    Selection.TypeText "  " & Slovy1(txt)
  End If
End Sub
obcasny_navstevnik
Junior

Odeslat příspěvekod neveceral 15. 9. 2008 22:19

velmi děkuji, bohužel, problém to pro mě je, protože jsem sotva pochopil, že problém je msgbox, mé schopnosti končí v nahrání makra, max. v jeho lehké úpravě. Ještě jednou velmi děkuji.
neveceral
Junior
Uživatelský avatar

Odeslat příspěvekod jambo1109 31. 1. 2009 23:21

Díky moc za pomoc, funguje i v Accessu, ušetří mi to spoustu práce.
Hezký den. ;-)
jambo1109
Kolemjdoucí

Odeslat příspěvekod ByTrit 26. 4. 2009 20:51

Zdravim mam mensi problem pri vacsich cislach (ako su miliony) sa pokazi sklonovanie cisloviek (napr z cisla 22milionov to spravi 22miliony co je blbost)
vo VBA som kedysi robil ale to je davno (asi 5 rokov dozadu) nasiel by sa niekto kto by vedel opravit toto sklonovanie?
ByTrit
Kolemjdoucí

Odeslat příspěvekod fatman 26. 4. 2009 21:14

OT:
ByTrit píše:napr z cisla 22milionov to spravi 22miliony co je blbost


Nevím jak ve slovenštině, ale v češtině je to správně - 22 miliony, 21 kilogram (čteno dvacet jeden kilogram - říkáme přeci jeden kilogram a ne jedna kilogramů), nicméně je povolen i tvar dvacetjedna kilogramů a korektní tvar 21 kilogram začíná být chápan jako zastaralý.
"Věřím v reinkarnaci, jakožto nutnou likvidaci materialisace lidské idealisace, bez vyloučení sensace!"
(J. Váchal, Krvavý román)
fatman
Junior
Uživatelský avatar

Odeslat příspěvekod obcasny_navstevnik 26. 4. 2009 22:23

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.
obcasny_navstevnik
Junior

Odeslat příspěvekod ByTrit 27. 4. 2009 16:59

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?
ByTrit
Kolemjdoucí

Odeslat příspěvekod Jandra 9. 2. 2010 11:31

Č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!
Jandra
Junior

Odeslat příspěvekod obcasny_navstevnik 9. 2. 2010 12:35

?? 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)
obcasny_navstevnik
Junior

Odeslat příspěvekod Jandra 9. 2. 2010 13:23

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

Odeslat příspěvekod Jandra 9. 2. 2010 21:29

Tak v Excelu 2007 již vše po opravě češtiny funguje! 8-)
Ještě jednou dík za pomoc! :tleskani
Jandra
Junior

Odeslat příspěvekod vforejt 23. 6. 2010 19:20

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
vforejt
Kolemjdoucí

Odeslat příspěvekod PaloPa 23. 6. 2010 21:50

vforejt píše: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
"Ať si bylo, jak si bylo, vždycky nějak bylo. Ještě nikdy nebylo, aby nějak nebylo" Josef Švejk
PaloPa
Junior
Uživatelský avatar

Odeslat příspěvekod radekbrblos 12. 8. 2010 11:09

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

Odeslat příspěvekod obcasny_navstevnik 12. 8. 2010 11:55

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
obcasny_navstevnik
Junior

Odeslat příspěvekod emikus 25. 2. 2011 15:25

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...
emikus
Kolemjdoucí

Odeslat příspěvekod PaloPa 25. 2. 2011 16:29

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

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

Palo
Přílohy
Slovom_SK.PNG
"Ať si bylo, jak si bylo, vždycky nějak bylo. Ještě nikdy nebylo, aby nějak nebylo" Josef Švejk
PaloPa
Junior
Uživatelský avatar

Odeslat příspěvekod obcasny_navstevnik 25. 2. 2011 17:22

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č"
obcasny_navstevnik
Junior

Odeslat příspěvekod emikus 25. 2. 2011 18:57

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

Odeslat příspěvekod Somebodyx 24. 5. 2011 15:55

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 ... 8-)

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

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.
Somebodyx
Kolemjdoucí

Odeslat příspěvekod AI Wintermute 18. 6. 2012 10:10

asi je to passé, ale třeba to pomůže někomu dalšímu - zkuste tuhle stránku - je tam ke stažení verze jako pro OpenOffice/LibreOffice, tak pro Excel 8-D

Převod čísla na text v OpenOffice a MS Excel
AI Wintermute
Junior
Uživatelský avatar

Odeslat příspěvekod xlnc 25. 6. 2012 13:49

Algoritmy jsou víceméně podobné, přidávám svou verzi do placu.

Kód: Vybrat vše
'---------------------------------------------------------------------------------------
' Procedura : epfCISLOSLOVNE
' Autor     : Petr Pecháček, Excelplus.NET
' Datum     : 7.11.2011
' Popis     : Funkce vrátí číslo vyjádřené slovně v poštovním formátu
' Příklad   : strCisloSlovne = epfCISLOSLOVNE(1567129)
'---------------------------------------------------------------------------------------
'
Public Function epfCISLOSLOVNE(ByVal Castka As Double, Optional ByVal _
    VelkePrvniPismeno As Boolean = True) As String

    Dim aJednotky As Variant
    Dim aDesitky As Variant
    Dim aStovky As Variant
    Dim aRady As Variant
    Dim aRady1 As Variant
    Dim aRady234 As Variant

    Dim i As Integer
    Dim iPocet3 As Integer
    Dim iDelka As Integer
    Dim iDelka3 As Integer
    Dim iStovky As Integer
    Dim iDesitkyJednotky As Integer

    Dim strCislo3 As String
    Dim strStovky As String
    Dim strRady As String
    Dim strDesitkyJednotky As String
    Dim strCisloText As String

    'vynucený přepočet funkce při změně na listu
    Application.Volatile True

    'pole pro desítky
    aDesitky = Array("", "deset", "dvacet", "třicet", "čtyřicet", _
        "padesát", "šedesát", "sedmdesát", "osmdesát", "devadesát")

    'pole pro jednotky
    aJednotky = Array("", "jedna", "dva", "tři", "čtyři", "pět", _
        "šest", "sedm", "osm", "devět", "deset", "jedenáct", "dvanáct", _
        "třináct", "čtrnáct", "patnáct", "šestnáct", "sedmnáct", _
        "osmnáct", "devatenáct")

    'pole pro stovky
    aStovky = Array("", "sto", "dvěstě", "třista", "čtyřista", _
        "pětset", "šestset", "sedmset", "osmset", "devětset")

    'pole pro řády
    aRady = Array("", "tisíc", "milionů", "miliard")
    aRady1 = Array("", "tisíc", "milion", "miliarda")
    aRady234 = Array("", "tisíce", "miliony", "miliardy")

    'skutečná délka čísla
    iDelka = Len(CStr(Castka))
    'délka čísla po zaokrouhlení na trojice nahoru
    iDelka3 = WorksheetFunction.Ceiling(iDelka, 3)
    'číslo formátované do trojic
    strCislo3 = Format(Castka, String(iDelka3, "0"))
    'počet trojic
    iPocet3 = iDelka3 \ 3

    'pro všechny trojice
    For i = 1 To iPocet3

        'počet stovek
        iStovky = Val(Mid(strCislo3, 3 * i - 2, 1))
        'počet desítek a jednotek
        iDesitkyJednotky = Val(Mid(strCislo3, 3 * i - 1, 2))

        'a) bez ošetření "jednosto"
        'strStovky = aStovky(iStovky + 1)

        'b) s ošetřením "jednosto"
        If iStovky = 1 And i = 1 Then
            strStovky = "jedno" & aStovky(iStovky + 1)
        Else
            strStovky = aStovky(iStovky + 1)
        End If

        'rozlišení desítek a jednotek
        Select Case iDesitkyJednotky
            Case 0
                If iStovky = 0 And iPocet3 = 1 Then
                    strDesitkyJednotky = "nula"
                End If
            Case 1
                'výjimka, "jeden" namísto "jedna" z pole
                'pro "jedentisíc", "jedenmilion", ...
                If iStovky = 0 And iPocet3 > 1 And i <> iPocet3 Then
                    'text desítek a jednotek
                    strDesitkyJednotky = "jeden"
                Else
                    'text desítek a jednotek
                    strDesitkyJednotky = aJednotky(iDesitkyJednotky + _
                        1)
                End If
                'text tisíců, milionů, ...
                strRady = aRady1(iPocet3 - i + 1)
            Case 2
                'výjimka, "dvě" namísto "dva" z pole
                'pro "dvě" (koruny)
                If iStovky = 0 And iPocet3 = 1 Then
                    'text desítek a jednotek
                    strDesitkyJednotky = "dvě"
                Else
                    'text desítek a jednotek
                    strDesitkyJednotky = aJednotky(iDesitkyJednotky + _
                        1)
                End If
                'text tisíců, milionů, ...
                strRady = aRady234(iPocet3 - i + 1)
            Case 3, 4
                strDesitkyJednotky = aJednotky(iDesitkyJednotky + 1)
                'text tisíců, milionů, ...
                strRady = aRady234(iPocet3 - i + 1)
            Case 5 To 19
                'text desítek a jednotek
                strDesitkyJednotky = aJednotky(iDesitkyJednotky + 1)
                'text tisíců, milionů, ...
                strRady = aRady(iPocet3 - i + 1)
            Case Is >= 20
                'text desítek a jednotek
                strDesitkyJednotky = aDesitky((iDesitkyJednotky \ 10) _
                    + 1) & aJednotky((iDesitkyJednotky Mod 10) + 1)
                'text tisíců, milionů, ...
                strRady = aRady(iPocet3 - i + 1)
        End Select

        strCisloText = strCisloText & strStovky & strDesitkyJednotky _
            & strRady

    Next i

    epfCISLOSLOVNE = IIf(VelkePrvniPismeno, UCase(Left$(strCisloText, _
        1)) & Mid$(strCisloText, 2), strCisloText)

End Function
Petr Pecháček
xlnc
Junior
Uživatelský avatar

Odeslat příspěvekod mpok 6. 12. 2012 17:43

Ahoj,
je to super a moc díky! :)
Jen mám dotaz ohledně "trvanlivosti".
Zadám si modul do excelu a pak mi převádí čísla na slava, super!
Ale jakmile excel zavřu, tak modul zmizí...
Jde nějak modul "nainstalovat" do excelu natrvalo?
Díky moc za radu! ;-)

Martin
mpok
Kolemjdoucí

Odeslat příspěvekod gabo516 6. 6. 2013 12:56

Dobrý den autorovi i úpravci makra. Mám s ním ale problém. Kód funguje v Excelu 2010. Excel 2002 vypisuje chybu, ale nenašel jsem důvod. Všechny použité fce se zdají být už dříve podporované. Děkuji za pomoc. G
gabo516
Kolemjdoucí

Odeslat příspěvekod JožoS 16. 12. 2014 21:48

ByTrit píše:Zdravim mam mensi problem pri vacsich cislach (ako su miliony) sa pokazi sklonovanie cisloviek (napr z cisla 22milionov to spravi 22miliony co je blbost)
vo VBA som kedysi robil ale to je davno (asi 5 rokov dozadu) nasiel by sa niekto kto by vedel opravit toto sklonovanie?


kód som upravil do sk a aj milióny zobrazuje správne a to som dnes s VBA robil 1.krát

jedine čo sa mi nedarí, aby aj desatinné čísla prepísalo na slovo

Kód: Vybrat vše
Function slovom(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", "dva", "tri", "štyri", _
"päť", "šesť", "sedem", "osem", "deväť")
Des1 = Array("desať", "jedenásť", "dvanásť", "trinásť", "štrnásť", _
"pätnásť", "šestnásť", "sedemnásť", "osmenásť", "devätnásť")
Des = Array("", "", "dvadsať", "tridsať", "štyridsať", "päťdesiat", _
"šesťdesiat", "sedemdesiat", "osemdesiat", "deväťdesiat")
Sta = Array("", "sto", "dvesto", "tristo", "štyristo", _
"päťsto", "šesťsto", "sedemsto", "osemsto", "deväťsto")
Tis = Array("tisíc", "tisíc", "tisíc", "tisíc", "tisíc", _
"tisíc", "tisíc", "tisíc", "tisíc", "tisíc")
JednTM = Array("", "jedna", "dva", "tri", "štyri", _
"päť", "šesť", "sedem", "osem", "deväť")
Mil = Array("miliónov", "milión", "milióny", "milióny", "milióny", _
"miliónov", "miliónov", "miliónov", "miliónov", "miliónov")
'
'
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
'
slovom = pom2 & slovom
Pol = Pol - Ofs: Rad = Rad + Ofs
'
Loop While Pol > 0
slovom = Trim(slovom) ' & " " & Right(StrCis, 2) ' pridani destinne casti
End Function
JožoS
Kolemjdoucí

Odeslat příspěvekod lk123 19. 6. 2017 16:31

Zdravím, chtěl jsem se zeptat, jestli máte někdo zkušenost s touto funkcí v Google disku, nebo Excel on line. Potřeboval bych ji využít v těchto programech.
Děkuji
lk123
Kolemjdoucí

Odeslat příspěvekod LPospa 31. 12. 2017 03:11

Ahoj.

Zrovna jsem vyzkoušel vaše zkušenosti a rady, ale našel jsem drobný problém. Pokud je číslo které se převádí s desetinným koncem, zobrazí se mi slovy pouze hodnota před desetinnou čárkou bez zaokrouhlení, např. 1258,99 napíše jedentisícdvěstěpadesátosm. Potřeboval bych poradit jak to upravit, aby se mi převedla na text až hodnota zaokrouhlená podle matematických pravidel. Pro mě samotného je to španělská vesnice, bez podrobného návodu v češtině či slovenštině bych nerozchodil ani tohle. Tímto taky děkuji všem přispěvatelům, kteří jsou ochotni poradit i takovým lamám, jako jsem já.
LPospa
Kolemjdoucí


Kdo je online

Uživatelé procházející toto fórum: Žádní registrovaní uživatelé a 0 návštevníků