Temat: Słwonie

Witam,

Mam plik Excela który służy mi jako baza danych do wzorcowego arkusza w Wordzie (korespondencja seryjna). W excelu jest kwota, którą chciałabym w kolejnej kolumnie przetwarzać na słownie, ale nie wiem jak to uczynić...?

Pozdrawiam,
Anita

Temat: Słwonie

Tworzymy funkcję w VBA:
1. Otwieram Excela, a w nim interesujący Cię skoroszyt.
2. Wstawiam do skoroszytu funkcję:
2.1. w uruchomionym Excelu, gdzie jest uruchomiony interesujący mnie skoroszyt - Zeszyt1.xlsm wciskam Alt+F11
2.2. Prawy przycisk myszy na obiekcie VBAProject(Zeszyt1) w menu VBAProject (jeśli menu niewidoczne pokazuję je za pomocą Ctrl+R) -> Insert -> Module
2.3. W prawym panelu wpisuję kod funkcji (poniżej)
3. Wracasz do arkusza zamykając edytor krzyżykiem.
, gdzie jej kod to:

Function Słownie(CzyWaluta As Boolean, Liczba As Variant) As Variant

'***********************************************************

' Makro do przeliczania liczby na słownie

' (c) 2001 by Bartłomiej Sosenko

'***********************************************************

 

Dim LiczbaP, Wynik, Slowo, SlowoP, Slowo2, i, Przyrostek

Grosze = ""

If InStr(1, Liczba, ",", 1) > 0 Then

 Grosze = Right(Liczba, Len(Liczba) - InStr(1, Liczba, ",", 1))

 If Len(Grosze) = 1 Then Grosze = Grosze & "0"

 If Len(Grosze) > 2 Then Grosze = Left(Grosze, 2)

 Liczba = Left(Liczba, InStr(1, Liczba, ",", 1) - 1)

End If

Jednostki = Array("", "jeden", "dwa", "trzy", "cztery", _

                  "pięć", "sześć", "siedem", "osiem", "dziewięć", _

                  "dziesięć", "jedenaście", "dwanaście", "trzynaście", _

                  "czternaście", "piętnaście", "szesnaście", "siedemnaście", _

                  "osiemnaście", "dziewiętnaście")

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")

Slowo = ""

For Gr = 1 To 2

If Len(Liczba) - (Len(Liczba) \ 3) * 3 = 2 Then Liczba = "0" & Liczba

If Len(Liczba) - (Len(Liczba) \ 3) * 3 = 1 Then Liczba = "00" & Liczba

For i = 1 To (Len(Liczba) + 2) \ 3

  SlowoP = ""

  If i > 1 Then

    LiczbaP = Mid(Liczba, Len(Liczba) - (i * 3) + 1, 3)

  Else

    LiczbaP = Liczba

  End If

  If Right(LiczbaP, 2) < 20 Then

    SlowoP = Jednostki(Right(LiczbaP, 2)) & " " & SlowoP

  Else

    Slowo2 = Dziesiatki(Left(Right(LiczbaP, 2), 1))

    Slowo2 = Slowo2 & " " & Jednostki(Right(LiczbaP, 1))

    SlowoP = Slowo2 & " " & SlowoP

  End If

  If LiczbaP > 99 Then

   SlowoP = Setki(Left(Right(LiczbaP, 3), 1)) & " " & SlowoP

  End If

  Select Case i

   Case 1:

            If CzyWaluta Then

              If (Gr = 2) Then

               Przyrostki = Array("grosz", "grosze", "groszy")

              Else

               Przyrostki = Array("złoty ", "złote ", "złotych ")

              End If

            Else

              If (Gr = 2) Then

               Przyrostki = Array("setna", "setne", "setnych")

              Else

               Przyrostki = Array("", "", "")

              End If

            End If

   Case 2:  Przyrostki = Array("tysiąc ", "tysiące ", "tysięcy ")

   Case 3:  Przyrostki = Array("milion ", "miliony ", "milionów ")

   Case 4:  Przyrostki = Array("miliard ", "miliardy ", "miliardów ")

   Case 5:  Przyrostki = Array("bilion ", "biliony ", "bilionów ")

  End Select

  If ((LiczbaP <> 0) And i > 1) Or (Gr > 0) Then

   If LiczbaP <> 0 Then

     If LiczbaP = 1 Then

      Przyrostek = Przyrostki(0)

     Else

        If ((Right(LiczbaP, 1) > 1) And (Right(LiczbaP, 1) < 5)) Or _

           ((Right(LiczbaP, 2) > 21) And (Right(LiczbaP, 1) > 1) And _

            (Right(LiczbaP, 1) < 5)) Then Przyrostek = Przyrostki(1)

        If ((Right(LiczbaP, 2) > 4) And (Right(LiczbaP, 2) < 22)) Or _

           ((Right(LiczbaP, 2) > 21) And (Right(LiczbaP, 1) > 4) And _

            (Right(LiczbaP, 1) < 22)) Or (Right(LiczbaP, 1) = 0) Or _

            (Right(LiczbaP, 1) = 1) Then Przyrostek = Przyrostki(2)

     End If

     If Gr = 1 Then

      Slowo = SlowoP & Przyrostek & Slowo

     Else

      Slowo = Slowo & SlowoP & Przyrostek

     End If

   End If

  End If

Next i

If Grosze = "" Then

 Exit For

Else

 If Liczba > 0 Then If Gr = 1 Then Slowo = Slowo & "i "

 Liczba = Grosze

End If

Next Gr

If Liczba = 0 Then Slowo = "zero" & Slowo

Słownie = Slowo

End Function 

Wywołujemy ją w arkuszu: =Słownie(Fałsz;A1) lub =Słownie(Prawda;A1) dla wskazania odpowiednio czy w wyniku interesuje nas wartość walutowa czy nie.

Pozdrawiam!Tomasz Gryzio edytował(a) ten post dnia 08.05.12 o godzinie 17:31

Temat: Słwonie

a tu na wszelki wypadek jeszcze moja wersja :)
http://akademia-vba.pl/access-vba/odwieczny-problem-fu...