Dobrej pokec   Lišanská šlapka   MSDN   VB na Microsoft.cz   NCHAT Nový design
   Portál  O firmě  Profil  Reference  Produkty  Odkazy  Diskuse  Tisková verze 



  Novinky e-mailem
Pokud chcete být informováni o změnách ,přihlašte se k odběru novinek!
  
  
  Nejčtenější články
 Seznam všech českých hubů abecedně. (32249)
 Seznam hubů nad 100 uživatelů (20974)
 Konfigurovatelné rozbalovací menu (17594)
 Jak na makra (14423)
 Rozbalovací menu v JavaScriptu (2.) (12797)
  Nejstahovanější soubory
 Action Meter (1846)
 Slovní Fotbal (777)
 IE Boss Guard (484)
 zdroják slovní fotbal (383)
 Folder Watcher (370)
  Anketa

  Nabídka portálu

 Adobe Premiere
    Jak se dá udělat
 Alternativní prohlížeče
    FireFox
 ASP
    Tipy a triky
 Direct Connect
    Huby
    Scripty pro HUB
    Tipy a triky CZDC++
 Game Maker
    Tipy a triky
 Hry
    Akční
    Logické
 HTML
    Scripting (VBS,JS)
    Tipy a triky
 Internet
    Užitečné triky
 Microsoft Office
    Tipy, triky, návody
    Užitečná makra
    VBA Tipy a triky
 MS SQL Server
    Nastavení
    Seriály
    Tipy a triky
 Multimedia
    Návody
 Oracle
    PL/SQL
 PHP
    Jak na to
    Tipy a triky
 Užitečné odkazy
    Grafické programy
    Programátorské
 Visual Basic
    DirectX
    Formuláře
    Jak se dá udělat ...
    Užitečné funkce
    Win32Api
    Zdroje
 Visual Basic .NET
    Užitečné funkce
 Vtípky
    Vtipy a anekdnoty
 Vypalování
    DVD Shrink
    Tipy a triky
 Windows
    Jak se dá ...
    Tipy a triky pro XP
    Triky pro IE


Nabídka portálu se při zobrazení článku přesouvá na konec pravého sloupce nabídek.

 Převod celého čísla na text ve VB

Autor: Kočí Marek
Zdroj: 
Vytvořeno: 24.9.2003
Publikováno: 26.9.2003
Čtenářů: 3901
Unikátních: 3708


od 0 do 9999999

Na formulář vložte 1x textbox a 1x command
a následující kód:

Private Sub Command1_Click()
   MsgBox Number2Text(Text1.Text)
End Sub

Public Function Number2Text _
    (ByVal vNumber As Variant) As String
  Dim lngTmp As Long
  
  If Not IsNumeric(vNumber) Then
     Number2Text = "Err0001 - Není číslo"
     Exit Function
  Else
    
    lngTmp = CLng(Int(vNumber))
    If lngTmp &> 9999999 Then
      Number2Text = "Err0002 - Max 9999999"
      Exit Function
    End If
  End If
  
  Number2Text = fncNum2Text(lngTmp)
End Function

Public Function fncNum2Text _
      (ByVal iNumber As Long) As String
  Dim PrevodDesitky(2 To 9) As String
  Dim Prevod100Tisice(1 To 9) As String
  Dim PrevodMiliony(1 To 9) As String
  Dim Miliony, StoTisice, DesetiTisice
  Dim Tisice, Stovky, Desitky, Zbytek
  Dim result
  Dim zast, I
  zast = Array("jedenmilion", "dvamiliony", _
               "třimiliony", "čtyřimiliony", _
               "pětmilionů", _
               "šestmilionů", "sedmmilionů", _
               "osmmilionů", "devětmilionů")
  For I = 1 To 9
    PrevodMiliony(I) = zast(I - 1)
  Next
  zast = Array("sto", "dvěstě", "třista", "čtyřista", _
               "pětset", "šestset", "sedmset", _
               "osmset", "devětset")
  For I = 1 To 9
    Prevod100Tisice(I) = zast(I - 1)
  Next
  zast = Array("dvacet", "třicet", "čtyřicet", _
               "padesát", "šedesát", "sedmdesát", _
               "osmdesát", "devadesát")
  For I = 2 To 9
    PrevodDesitky(I) = zast(I - 2)
  Next
  
  Miliony = iNumber \ 1000000
  If Miliony &>= 1 Then
    Zbytek = iNumber Mod 1000000
    result = result & PrevodMiliony(Miliony)
  Else
    Zbytek = iNumber
  End If
  
  StoTisice = Zbytek \ 100000
  If StoTisice &>= 1 Then
    Zbytek = iNumber Mod 100000
    result = result & Prevod100Tisice(StoTisice)
  Else
    Zbytek = iNumber
  End If
  
  
  DesetiTisice = Zbytek \ 10000
  If DesetiTisice &> 1 Then
    Zbytek = iNumber Mod 10000
    result = result & PrevodDesitky(DesetiTisice)
  Else
    Zbytek = iNumber
  End If
  
  Tisice = Zbytek \ 1000
  If Tisice &> 0 Then
    Zbytek = Zbytek Mod 1000
    result = result & Prevod(1000, Tisice)
  Else
    If DesetiTisice &> 0 Then _
       result = result & "tisíc"
  End If
  
  Stovky = Zbytek \ 100
  If Stovky &> 0 Then
    Zbytek = Zbytek Mod 100
    result = result & Prevod(100, Stovky)
  End If
  
  Desitky = Zbytek \ 10
  If Desitky &> 1 Then
    Zbytek = Zbytek Mod 10
    result = result & PrevodDesitky(Desitky)
  End If
  
  If Zbytek &> 0 Then
    result = result & Prevod(1, Zbytek)
  End If
  
  fncNum2Text = result
End Function

Private Function Prevod(Rad, Hodnota) As String
 Dim Jednotky(5 To 19) As String
 Dim zast, I, result
  zast = Array("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")
  For I = 5 To 19
    Jednotky(I) = zast(I - 5)
  Next
 
  

 If (Hodnota &> 4) And (Hodnota &< 20) Then _
     result = Jednotky(Hodnota)
   If Rad = 1000 Then
     result = result & "tisíc"
     If Hodnota = 1 Then result = "jedentisíc"
     If Hodnota = 2 Then result = "dvatisíce"
     If Hodnota = 3 Then result = "třitisíce"
     If Hodnota = 4 Then result = "čtyřitisíce"
   End If

   If Rad = 100 Then
     result = result & "set"
     If Hodnota = 1 Then result = "jednosto"
     If Hodnota = 2 Then result = "dvěstě"
     If Hodnota = 3 Then result = "třista"
     If Hodnota = 4 Then result = "čtyřista"
   End If

   If Rad = 1 Then
     If Hodnota = 1 Then result = "jedna"
     If Hodnota = 2 Then result = "dvě"
     If Hodnota = 3 Then result = "tři"
     If Hodnota = 4 Then result = "čtyři"
   End If
 
   Prevod = result
End Function





Příspěvky ke článku:



© Swit.cz, Marek Kočí 2003