Visual Basic 4 All - programowanie kurs vba przykłady tutorial sources

Szybkie szukanie

sobota, 11 luty 2012

Start

Start

Tips & Tricks

Zamiana liczb na słowa

Napisał Bartek

niedziela, 17 wrzesień 2006

Kolejna funkcja zmieniajaca liczby na ich słowny odpowiednik.

############################################################
Public Function slownie(wejscie As Currency) As String

'Funkcja konwersji wartosci liczbowej (int/cur/double/float) na liczebnik
(string)

'---------------------------------------------------------------------------
-----------
' ................... autor : Barman ..
....................................
'---------------------------------------------------------------------------
-----------

'........ UWAGA ....................
'Autor nie bierze odpowiedzialnosci, za ewentualne niewłasciwe działanie
programu ;-)
'W FUNKCJI CELOWO ZOSTAL ZASZYTY PEWIEN BŁĄD, zatem bezmyslne kopiowanie i
wpinanie funkcji do wlasnych komercyjnych aplikacji nie jest wskazane
'...................................

Dim tys_pusty As Boolean
Dim mln_pusty As Boolean
Dim ile_cyfr As Integer
Dim liczba As Variant
Dim i As Integer
Dim temp As String
Dim jednosci As Variant
Dim dziesiatki As Variant
Dim setki As Variant
Dim tys As Variant
Dim milion As Variant
Dim miliard As Variant
Dim bilion As Variant

'definicje tablic liczebników składowych
jednosci = Array("", "jeden ", " dwa ", " trzy ", " cztery ", " pięć ", "
sześć ", " siedem ", " osiem ", " dziewięć ")
dziesiatki = Array("", " dziesięć ", " dwadzieścia ", " trzydzieści ", "
czterdzieści ", " pięćdziesiąt ", " sześćdziesiąt ", " siedemdziesiąt ", "
osiemdziesiąt ", " dziewięćdziesiąt ")
setki = Array("", " sto ", " dwieście ", " trzysta ", " czterysta ", "
pięćset ", " sześćset ", " siedemset ", " osiemset ", " dziewięćset ")
tys = Array("", " tysiąc ", " tysiące ", " tysięcy ")
milion = Array("", " milion ", " miliony ", " milionów ")
miliard = Array("", " miliard ", " miliardy ", " miliardów ")
bilion = Array("", " bilion ", " biliony ", " bilionów ")

nascie = Array("", " jedenaście ", " dwanaście ", " trzynaście ", "
czternaście ", " piętnaście ", " szesnaście ", " siedemnaście ", "
osiemnaście ", " dziewiętnaście ")
tys_pusty = False
mln_pusty = False
flgnast = False
napis = Format(wejscie, "#.00")

ile_cyfr = Len(napis) - 3

   For i = 1 To ile_cyfr
        Select Case ((3 + (ile_cyfr - i)) Mod 3)
        Case 1
         If ((ile_cyfr > 1) And (Val(Mid(napis, (i), 2)) < 20) And
(Val(Mid(napis, (i), 2)) > 10)) Then
          slownie = slownie & nascie(Val(Mid(napis, i + 1, 1)))
          i = i + 1
          flgnast = True
         Else
          slownie = slownie & dziesiatki(Val(Mid(napis, i, 1)))
         End If

         Case 0
          slownie = slownie & jednosci(Val(Mid(napis, i, 1)))

        Case Else
         slownie = slownie & setki(Val(Mid(napis, i, 1)))
       End Select

     If ((ile_cyfr - i) = 12) Then
        Select Case Val(Mid(napis, i, 1))
         Case 1
          If (ile_cyfr) > 13 Then
            slownie = slownie & bilion(3)
           Else
             slownie = slownie & bilion(1)
           End If
         Case 2 To 4
           slownie = slownie & bilion(2)
         Case Else
           slownie = slownie & bilion(3)
       End Select
     End If

     If (ile_cyfr - i) = 9 Then

        If flgnast = True Then
          slownie = slownie & miliard(3)
          flgnast = False
        Else
          Select Case Val(Mid(napis, i, 1))
           Case 1
             If (ile_cyfr) > 10 Then
               slownie = slownie & miliard(3)
             Else
               slownie = slownie & miliard(1)
             End If
           Case 2 To 4
             slownie = slownie & miliard(2)
           Case Else
             slownie = slownie & miliard(3)
          End Select
        End If
      End If

     If (ile_cyfr - i) = 6 Then
          If (Val(Mid(napis, (i + 1), 3)) = 0) Then
              tys_pusty = True
           End If

        If flgnast = True Then
             slownie = slownie & milion(3)
             flgnast = False
        Else
          Select Case Val(Mid(napis, i, 1))
           Case 1
             If (ile_cyfr) > 7 Then
               slownie = slownie & milion(3)
              Else
                slownie = slownie & milion(1)
            End If
           Case 2 To 4
             slownie = slownie & milion(2)
           Case Else
             slownie = slownie & milion(3)
           End Select
        End If
      End If

     If ((ile_cyfr - i) = 3 And tys_pusty = False) Then
        If flgnast = True Then
           slownie = slownie & tys(3)
           flgnast = False
        Else
          Select Case Val(Mid(napis, i, 1))
           Case 1
             If (ile_cyfr) > 4 Then
               slownie = slownie & tys(3)
             Else
               slownie = slownie & tys(1)
             End If
           Case 2 To 4
             slownie = slownie & tys(2)
           Case Else
             slownie = slownie & tys(3)
         End Select
       End If
     End If

   Next

    slownie = slownie & " zł "
    slownie = slownie & Mid(napis, (Len(napis) - 1), 2) & "/100 gr"

End Function

###################################################################

Komentarze

B?edy w funkcji
Dodane przez bartek w dniu - 2006-09-20 23:10:28

Przyznaje sie zatem do b?edów:
1. Nie ma opcji odmiany wyrazu bilion w przypadku "-nastu" (miliardy,miliony,tysiace maja tą opcj?).
2. W przypadku podania duzej liczby, w ktorej milionow lub mililardów b?dzie równa 0, program mimo to je wypisze - co oczywiscie nie jest pooprawne.

Aby dodać komentarz zaloguj się. Jeśli nie masz konta, załóż je sobie.
Tylko zarejestrowani użytkownicy mogą pisać komentarze.

< Poprzedni		Następny >

[ Wróć ]

Menu główne

Logowanie

Gościmy
Aktualnie jest 29 gości online

Statystyka
Użytkownicy: 11345 Newsy: 237 Odnośniki: 48 Odwiedzających: 4327667

Mambo is Free Software released under the GNU/GPL License.