Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
Przesunięty przez: master_mix
29-12-2010, 12:42
22. Kwoty słownie
Autor Wiadomość
Developmax 
Excel Expert


Posty: 242
Wysłany: 27-06-2007, 09:04   22. Kwoty słownie

Przykład nie jest mojego autorstwa, ale dostępny w internecie. Swego czasu pisałem taką funkcję pod VB (na potrzeby Excela musiałbym ją nieco zmodyfikować).

Generalnie tego typu funkcje można pisać na różne sposoby, a polega to na odpowiednim wyciąganiu słów znaczących przy pomocy takich poleceń wbudowanych w VBA, jak: right, left czy mid.

Pzdr

Slownie.zip
Pobierz Plik ściągnięto 7962 raz(y) 10.56 KB

_________________
Na drzewie dobrych intencji jest wiele kwiatów, lecz mało owoców...
ID posta: 8977 Skopiuj do schowka
 
 
cerber1 
Excel Expert


Posty: 145
Wysłany: 27-06-2007, 11:32   

Jeśli ktoś ma awersję do kodu VBA, lub chce zobaczyć jak można to samo zrobić używając bardziej "ludzkiego" języka :-D niech zobaczy poniższy plik.
Dodatkowo jest tu możliwość różnego formatowania kwoty wyrażanej w słowach.

(Nie jestem autorem tego pliku, został znaleziony w necie . Nie znam też autora)

Słownie_bez_VBA.zip
Pobierz Plik ściągnięto 9707 raz(y) 19.19 KB

_________________
Pozdrawiam!
Piotr
ID posta: 9020 Skopiuj do schowka
 
 
Misza12
[Usunięty]

Wysłany: 11-07-2007, 21:37   

Kiedyś znalazłem takie coś w necie, wystarczy tylko to skopiować w folder AddIns a następnie wejść w dodatki i odchaczyć :-) U mnie to działa.

slownie.rar
dodatek
Pobierz Plik ściągnięto 5150 raz(y) 17.2 KB

ID posta: 10145 Skopiuj do schowka
 
 
krzysztof_ml
Starszy Forumowicz


Posty: 58
Wysłany: 16-07-2007, 01:30   

Misza12
Jak zastosować Twoją "kwota słownie" w Excelu 2007?

[ Dodano: 2007-07-16, 13:46 ]
cerber1, Prosiłbym, abyś napisał "krok po kroku" jak zastosować Twoją "kwota słownie bez VBA". Próbuję, ale nie udaje mi się
ID posta: 10422 Skopiuj do schowka
 
 
cerber1 
Excel Expert


Posty: 145
Wysłany: 17-07-2007, 07:46   

krzysztof_ml napisał/a:
cerber1, Prosiłbym, abyś napisał "krok po kroku" jak zastosować Twoją "kwota słownie bez VBA". Próbuję, ale nie udaje mi się

To bardzo proste.
Musisz w jakimkolwiek arkuszu mieć komórkę gdzie będziesz wpisywał, bądź będzie obliczana liczba do zamiany na wartość słowną. ( w tym wypadku Arkusz1!A1) potem w arkuszu Konwersja wpisujesz w komórce I3 formułę z łączem do tej kmórki (=ZAOKR(Arkusz1!A1;2)).
Następnie musisz wybrać komórkę w której chcesz mieć przekonwertowaną liczbę na tekst i tam wpisać odpowiednią formułę, w zależności od tego jaki format chciałbyś uzyskać. (w tym wypadku to komórki z zakresu A2:A5) Jak taka formuła ma wyglądać, możesz zobaczyć na pasku formuły, po zaznaczeniu konkretnej komórki.
Teraz ukrywasz wszystkie arkusze poza arkuszem1, żeby nie mąciły widoku. :mrgreen:
_________________
Pozdrawiam!
Piotr
ID posta: 10499 Skopiuj do schowka
 
 
plitfyg 
Excel Expert


Posty: 107
Wysłany: 05-02-2008, 23:17   

Cześć,

Chciałem dodać kolejne (tym razem moje) rozwiązanie z serii "kwoty słownie bez VBA".
Plik w załączniku.


Marcin

excelblog.pl_kwoty_slownie.zip
Pobierz Plik ściągnięto 7570 raz(y) 12.59 KB

_________________
Więcej odpowiedzi na ciekawe pytania znajdziesz także na moim blogu www.excelblog.pl
ID posta: 27195 Skopiuj do schowka
 
 
piotrh21
[Usunięty]

Wysłany: 07-02-2008, 15:13   

Witam wszystkich,

może zainteresują kogoś 2 wersje pliku podanego przez Developmax tzn. Kwoty słownie pod VBA, lecz trochę poprawione, bez zbędnych spacji i z różnymi końcówkami krótkich lub pełnych złotych i groszy. Może to będzie w części odpowiedź na sugestię krzysztof_ml.

Pozdrawiam :-)

KwotySlownie.rar
Pobierz Plik ściągnięto 2634 raz(y) 23.79 KB

ID posta: 27324 Skopiuj do schowka
 
 
yesosenk
[Usunięty]

Wysłany: 27-03-2008, 23:51   

Witam,
właśnie dołączyłem do czytelników forum. Musze przyznać że zaskoczyło mnie swoim wysokim poziomem.
Na początek wrzucę moją wersję makra przetwarzającej liczbę na słownie w wersji walutowej lub nie.
W komórce w której chcemy otrzymać wynik wpisujemy
=Słownie(PRAWDA;A1)
gdzie
pierwszy parametr określa czy podana wartość to waluta czy nie
A1 to komórka zawierająca wartość do konwersji.
Funkcję napisałem w 2001 roku więc pewnie teraz bym w niej co nie co poprawił - ale skoro działa to mi się nie chce :)
Jest za to chyba najkrótszą funkcją jaką do tej pory spotkałem i działa bez zarzutu.

Kod:

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
ID posta: 31581 Skopiuj do schowka
 
 
Piotr_Korbicz 
Excel Expert


Posty: 534
Wysłany: 14-04-2008, 22:27   

Drobna przeróbkam jeśli można (bo funkcja faktycznie jest krótka więc ją sobie upatrzyłem ;-) ) umożliwiająca zamianę na tekst również liczb ujemnych (jest takie zapotrzebowanie ze strony Forumowiczów).
Dodatkowo zmieniłem kolejność argumentów (pierwsza jest liczba), drugi argument jest opcjonalny (można pominąć - domyślnie tekst jest walutowy)

Kod:
Function Słownie(Liczba As Variant, Optional CzyWaluta) As Variant
'***********************************************************
' Makro do przeliczania liczby na słownie
' (c) 2001 by Bartłomiej Sosenko
'***********************************************************
 
Dim LiczbaP, Wynik, Slowo, SlowoP, Slowo2, i, Przyrostek

If IsMissing(CzyWaluta) Then CzyWaluta = True

If Liczba < 0 Then
Liczba = -Liczba
przedrostek = "minus "
End If


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 = IIf(IsEmpty(przedrostek), Slowo, przedrostek & Slowo)
End Function
ID posta: 33256 Skopiuj do schowka
 
 
tkuchta1 
Excel Expert



Posty: 2779
Wysłany: 28-04-2008, 12:43   

chcę dorzucić drobnostkę od siebie:
Napisałem kiedyś kalkulator zamieniający wartość liczbową na słownie, oparty na funkcjach =mod, =jeżeli i =złącz.teksty działa w zakresie 0,01 - 20999,99 więc w porównaniu z waszymi nie ma o czym mówić, ale mi wystarcza więc nie widziałem potrzeby rozszerzania zakresu

Zaciekawił mnie fragment wypowiedzi Piotr_Korbicz dotycząca makra yesosenk:
makro umożliwia "zamianę na tekst również liczb ujemnych (jest takie zapotrzebowanie ze strony Forumowiczów)."

Sprawdzałem, że inne kalkulatory rzeczywiście nie działają w zakresie liczb ujemnych i tu moje 3 grosze:
Sory za banalny przykład ale:

A1 - [miejsce wprowadzania wartości liczbowej]
B1=ZNAK.LICZBY(A1)
C1=A1*B1
D1=JEŻELI(B1=(-1);"minus ";"")
E1=JEŻELI(C1=1;"jeden";JEŻELI(C1=2;"dwa";"inna"))
F1=ZŁĄCZ.TEKSTY(D1;E1)

Kalkulator dział w zakresie liczb całkowitych (-2,2)
******************************************************************
Edit::
ile razy to czytam to chcę to poprawić i jakoś normalnie wyartykułować. No i przyszła na to pora:
Jezeli dana funkcja nie działa w zakresie liczb ujemnych to wystarczy zamiast
Kod:
=slownie(A1)

wpisać
Kod:
=JEŻELI(A1<0;"minus "&slownie(A1*-1);slownie(A1))
Ostatnio zmieniony przez tkuchta1 11-09-2008, 14:08, w całości zmieniany 3 razy  
ID posta: 34320 Skopiuj do schowka
 
 
Piotr_Korbicz 
Excel Expert


Posty: 534
Wysłany: 11-03-2009, 19:57   

W odpowiedzi na post jednego z Forumowiczów zacząłem się bawić, i wybawiłem co w załączeniu.
Obsługuje liczby dodatnie do 999 milionów.
Formuły zacząłem nieszczęśliwie pisać od lewej do prawej (arkusz "Formuły") stąd głupawo może to wygląda ... ale nie chciało mi się przerabiać.
Kto ma zapał lub potrzeby niech testuje ;-)

SŁOWNIE.rar
Pobierz Plik ściągnięto 708 raz(y) 4.28 KB

ID posta: 60360 Skopiuj do schowka
 
 
fx7
[Usunięty]

Wysłany: 12-03-2009, 00:27   

Tutaj jest dobre narzędzie online do kwoty słownie. Nie jest to dodatek do exela ale działa bardzo dobrze
ID posta: 60380 Skopiuj do schowka
 
 
zbiniek 
Excel Expert



Zaproszone osoby: 1
Posty: 1541
Wysłany: 12-03-2009, 07:47   

Witam!

To ja jeszcze dorzucę to. To dla tych co:
- nie mają sieci on-line,
- nie wiedzą (nie chcą wiedzieć) jak korzystać z dodatków excela,
- chcą używać kwot słownie w innych programach.

Z powodzeniem używam tego od dłuższego czasu.
_________________
pozdrawiam
zbiniek

Prawdopodobieństwo otrzymania satysfakcjonującej odpowiedzi jest proporcjonalne do właściwego sformułowania problemu (popartego załącznikiem)

Jest załącznik - jest impreza

http://rtfm.killfile.pl/
ID posta: 60387 Skopiuj do schowka
 
 
bodek 


Posty: 2223
Wysłany: 13-07-2009, 18:58   

Zatem tak, poprawiłem kod (uzupełniłem o deklaracje) i osobiście go używam od roku (Ex 2003), zatem powinno działać jak należy
Kod:
Function Słownie(Liczba As Variant, Optional CzyWaluta) As Variant
'***********************************************************
' Makro do przeliczania liczby na słownie
' (c) 2001 by Bartłomiej Sosenko
'***********************************************************

Dim LiczbaP, Wynik, Slowo, SlowoP, Slowo2, i, Przyrostki
Dim Przyrostek, Przedrostek, Grosze, Jednostki, dziesiatki, setki, gr

If IsMissing(CzyWaluta) Then CzyWaluta = True

If Liczba < 0 Then
Liczba = -Liczba
Przedrostek = "minus "
End If


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 = IIf(IsEmpty(Przedrostek), Slowo, Przedrostek & Slowo)
End Function

W arkuszu Excela, na dowolnej zakładce z nazwą dowolnego arkusza (na dole okna) -> PPM (prawy przycisk myszy) -> wyświetl kod
Wyskoczy edytor VBA, nowe takie coś :mrgreen:
Menu -> Insert -> module (wstawiasz nowy moduł do przechowywania kodu)
W prawe (największe) okno kopiujesz kod (ten powyżej)
Zamykasz edytor VBA (x)
W dowolnym z arkuszy wpisujesz w komórkę
Kod:
="słownie: " & słownie($D$23)
gdzie D23 to adres komórki, w której masz liczbę, którą chcesz przedstawić słownie.
Można też wprost, bez tekstów
Kod:
=słownie(D23)


p.s.
Musisz mieć dozwolone działanie makr.
_________________
Szkolenia z Excela
Forum nieczynne? Zapraszam na:
Grupa Excel na GL
ID posta: 68656 Skopiuj do schowka
 
 
J@veliner 
Excel Expert



Zaproszone osoby: 1
Posty: 273
Wysłany: 23-09-2009, 15:54   

Ja w przykładzie bodka, zamienił bym jeszcze fragment
Kod:
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)

na
Kod:
If InStr(1, Liczba, Application.DecimalSeparator, 1) > 0 Then
 Grosze = Right(Liczba, Len(Liczba) - InStr(1, Liczba, Application.DecimalSeparator, 1))
 If Len(Grosze) = 1 Then Grosze = Grosze & "0"
 If Len(Grosze) > 2 Then Grosze = Left(Grosze, 2)
 Liczba = Left(Liczba, InStr(1, Liczba, Application.DecimalSeparator, 1) - 1)
End If


Ponieważ niektórzy (tak jak ja) mogą mieć "." jako separator dziesiętnych a ta drobna modyfikacja pozwoli na działanie funkcji w obu przypadkach :-)
_________________
Pzdr
J@veliner
ID posta: 72954 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum


Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.