X

Excel formuła do zmiany kwoty na tekst (kwota słownie)

19 May 2009 22:44 BKbkroy
  • #1 19 May 2009 22:44
    bkroy
    Level 11  
    Helpful post? (0)
    Witam,
    W jaki sposób w excelu można zmienić wartość z komórki, w której jest wpisana kwota (liczba) na tekst (liczba zapisana słownie). Potrzebuję taką formułę do wystawiania faktur vat wewnętrznych. Proszę o pomoc.

    Pozdrawiam.
  • #2 19 May 2009 22:48
    adamas_nt
    Moderator Programowanie
    Helpful post? (0)
    Akurat jest funkcja użytkownika w tym temacie: http://www.elektroda.pl/rtvforum/topic1315405.html
    i wielu innych miejscach internetu.
  • #3 19 May 2009 22:56
    marek003
    Level 39  
    Helpful post? (0)
    Z reguły za pomocą makra. Można też w dodatkowym arkuszu ale to więcej zabawy niż to warte.

    Wpisz w google kwota słownie w excelu lub coś w tym stylu a znajdziesz parędziesiąt rozwiązań.
    Tutaj np. jedno z nich z delikatnym opisem co zrobić:
    http://blog.grzegorzsurowiec.pl/2009/01/15/tworzymy-makro-dla-programu-microsoft-excel/
  • #4 26 Apr 2010 20:08
    RadekS
    Level 11  
    Helpful post? (+5)
    może nieco i późno ale lepiej to niż wcale ;)
    załączam plik w którym jest i opis i pliczek,
    który zamienia wartości liczbowe na wartość "słownie"
    Doprawdy ułatwia życie! :)

    Plik “Slownie.xls” należy przekopiować do folderu [dysk]:\Microsoft Office\Office\XLStart. Po tym zabiegu przy każdym otwarciu arkusza będzie dostępna nowa funkcja (SŁOWNIE.XLS!słownie()) we “Wklej funkcję/Kategoria funkcji:/Użytkownika”. Po wywołaniu funkcji należy podać w polu “argument” bezpośrednio liczbę lub wskazać komórkę z której będzie pobierany argument.
    Attachments:
  • #5 29 Apr 2010 13:37
    okobaka
    Level 9  
    Helpful post? (0)
    http://www.elektroda.pl/rtvforum/topic84095.html
    Tutaj tez poruszyli temat, kwota słownie. maksymalnie do 999 999,99 zł
  • #6 02 May 2010 14:54
    RadekS
    Level 11  
    Helpful post? (0)
    okobaka: w temacie: http://www.elektroda.pl/rtvforum/topic84095.html - sprawa została oparta o makra, vba, natomiast zapodany przeze mnie gotowiec jest wywoływany funkcyjnie, a uruchamia się każdorazowo gdy włączamy excela. Reasumując - każdy sposób prowadzący do określonego celu jest jak najbardziej dobry
  • #7 08 Jun 2010 18:33
    dawidmarek
    Level 7  
    Helpful post? (0)
    Witam
    Super sprawa z tą funkcją, ale Ja mam taki problem. Mam listę obecności, i w jednej z komórek mam w pisane ilość godzin przepracownych cyfrą a zaś w urlop wypoczynkowy mam pisany skrótem "UW"
    I tutaj mam pytanie jaką funkcję użyć żeby sumę tekstu "UW" dodało mi i w podsumowanie wpisało np.

    Urlop ilość 8

    Proszę o pomoc
    Pozdrawiam
  • #8 09 Jun 2010 08:26
    walek33
    Level 28  
    Helpful post? (0)
    dawidmarek wrote:
    Witam
    Super sprawa z tą funkcją, ale Ja mam taki problem. Mam listę obecności, i w jednej z komórek mam w pisane ilość godzin przepracownych cyfrą a zaś w urlop wypoczynkowy mam pisany skrótem "UW"
    I tutaj mam pytanie jaką funkcję użyć żeby sumę tekstu "UW" dodało mi i w podsumowanie wpisało np.

    Urlop ilość 8

    Proszę o pomoc
    Pozdrawiam


    Nie chcę być marudny, ale to już chyba sprawa na nowy temat?
    A tak na marginesie, jeżeli te dane są w dwóch kolumnach to użyj formuły suma.jeżeli(zakres;"UW";suma_zakres)

    Dodane:
    Jeżeli dane są w jednej kolumnie:
    licz.jeżeli(zakres;"UW")*8
  • #9 04 Jul 2010 12:44
    okobaka
    Level 9  
    Helpful post? (-1)
    RadekS wrote:
    okobaka: w temacie: http://www.elektroda.pl/rtvforum/topic84095.html - sprawa została oparta o makra, vba, natomiast zapodany przeze mnie gotowiec jest wywoływany funkcyjnie, a uruchamia się każdorazowo gdy włączamy excela. Reasumując - każdy sposób prowadzący do określonego celu jest jak najbardziej dobry


    Korzystam z twojej funkcji, zauważyłem jednak, ze jeśli sie ja skopuje do C:\Microsoft Office\Office\XLStart to otwiera się okno programu excel jednak jest puste - trzeba je zminimalizowac i dopiero potem otwiera sie skoroszyt w oknie i tak jest za kzadym razem.

    RadekS mial bym do ciebie taka prośbę żebyś dodał to tej funkcji grosze ale zapisywane w ten sposób :)
    np: 99,99 = dziewięćdziesiąt dziewięć zł i 99/100 gr :)
    i zeby za kazdym razem funkcja pokazywala grosze
    np: 99,00 = dziewięćdziesiąt dziewięć zł i 00/100 gr
    i wywalić z wyniku funkcji nawiasy oraz tekst (slownie:)

    był bym wdzięczny.
  • #10 06 Jul 2010 01:28
    RadekS
    Level 11  
    Helpful post? (0)
    hmm nie jest to moja -jak napisałeś - formuła/funkcja, sam z niej korzystam ponieważ jest wygodna i prosta, natomiast nie pracowałem przy jej tworzeniu

    proponuję zapoznać się z innymi tego typu rozwiązaniami podanymi w plikach, jak również z opracowaniem ze strony:
    http://www.excelblog.pl/kwota-slownie-bez-vba/
  • #11 08 Jul 2010 07:33
    okobaka
    Level 9  
    Helpful post? (0)
    Dzięki za sprostowanie ... wystarczyło by poprawić w tej funkcji trochę, wiesz może skąd jest ten plik "Slownie.zip" - bo szukam źródła?

    Edytowany 28.07.2010
    Dzisiaj miałem trochę czasu i porostu wcisnąłem ALT+F11 i wyskoczyło to makro o które mi chodziło można zmienić co się chce ... jest również autor i tp informacje ...

    Edytowany 02.08.2010
    Zmieniłem jeszcze raz makro w ten sposób:

    zamieniłem ten kawałek kodu, który był oryginalnie ...
    Code:
    'If po_przecinku >= 1 Then
    ' liczba = po_przecinku
    ' GoSub zamiana
    ' y$ = xxx$
    ' groszy$ = " " + y$ + " gr) "
    ' Else
    ' groszy$ = ") "
    'End If

    ... tym kawałkiem kodu.
    Code:
     reszta_z$ = Int(po_przecinku)
    
    If reszta_z$ >= 0 And reszta_z$ <= 9 Then
    reszta_z$ = "0" & reszta_z$
    End If
    
    If reszta_z$ = 0 Then
    reszta_z$ = "00"
    End If
    
    liczba = reszta
    GoSub zamiana
    yyyyy$ = xxx$
    słownie = "Słownie złotych: " + nazwa_md$ + nazwa_mil$ + nazwa_tys$ + yyyyy$ + " zł " + reszta_z$ + "/100 gr"
    GoTo koniec


    aby wyświetlała się:
    Słownie złotych: siedem milionów sto czternaście tysięcy dziewięćset dziewięćdziesiąt siedem zł 21/100 gr
    oraz
    Słownie złotych: siedem milionów sto czternaście tysięcy dziewięćset dziewięćdziesiąt siedem zł 00/100 gr
    oraz
    Słownie złotych: siedem milionów sto czternaście tysięcy dziewięćset dziewięćdziesiąt siedem zł 01/100 gr

    Już nie będzie więcej modyfikacji ... :)
  • #12 20 Dec 2010 12:16
    Kluska81
    Level 8  
    Helpful post? (0)
    witam

    @okobaka
    mógłbyś wrzucić gotowe po modyfikacja makro

    EDIT:

    znalazłem w sieci takie makro, tylko jest jeden problem że wartość grosze również podaje słownie
    np.
    123,45zł
    sto dwadzieścia trzy złote i czterdzieści pięć groszy
    a chciałbym uzyskać taki efekt
    sto dwadzieścia trzy 45/100 zł

    Code:
    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


    czy mógłbym prosić o pomoc w modyfikacji makra
  • #13 24 Feb 2011 09:17
    robson1313
    Level 2  
    Helpful post? (0)
    Bardzo wygodne rozwiązanie:
    Do biblioteki "wkłada się" plik nabla.xla np.
    ='C:\Program Files\Microsoft Office\OFFICE11\LIBRARY\NABLA.XLA
    bądż w innej ścieżce, w której są biblioteki.
    W dodatkach excela wystąpi jako 'nabla"
    Używanie: wstaw funkcję(finansowe) SFAKT(.....)
    Nie zawsze odmienia prawidłowo przez przypadki ale, to chyba do przeżycia.
  • #14 29 Dec 2011 20:29
    artimman
    Level 2  
    Helpful post? (0)
    Może szybciej i wygodnie będzie
    przekonwertować kwotę słownie online.
  • #15 24 Feb 2012 13:57
    jar_gogo
    Level 10  
    Helpful post? (0)
    Siemka @okobaka

    Czy mógłbyś udostępnić makro z postu powyżej, gdyż bardzo potrzebuję a niestety pisanie makr nie jest w cale moją mocna stroną. Tobie udało się, a zależy mi właśnie na takiej formie wyświetlania jaka Ty wyedytowałeś. A dokładniej chodzi mi właśnie aby wyświetlało się w taki sposób:

    159.37 zł
    Słownie złotych: sto pięćdziesiąt dziewięć zł 37/100 gr


    Z góry w swoim i nie swoim imieniu dziękuję i pozdrawiam.
  • #16 09 May 2012 09:07
    misiuv
    Level 2  
    Helpful post? (0)
    ja polecam rozwiązanie oparte o funkcje użytkownika
  • #17 17 May 2012 10:38
    Ludek72
    Level 7  
    Helpful post? (0)
    RadekS wrote:
    może nieco i późno ale lepiej to niż wcale ;)
    załączam plik w którym jest i opis i pliczek,
    który zamienia wartości liczbowe na wartość "słownie"
    Doprawdy ułatwia życie! :)

    Plik “Slownie.xls” należy przekopiować do folderu [dysk]:\Microsoft Office\Office\XLStart. Po tym zabiegu przy każdym otwarciu arkusza będzie dostępna nowa funkcja (SŁOWNIE.XLS!słownie()) we “Wklej funkcję/Kategoria funkcji:/Użytkownika”. Po wywołaniu funkcji należy podać w polu “argument” bezpośrednio liczbę lub wskazać komórkę z której będzie pobierany argument.


    Dzięki serdeczne.
  • #18 30 May 2012 09:12
    okobaka
    Level 9  
    Helpful post? (0)
    Post wedytowałem, ale teraz czeka na akceptacje zmiany moderatora. Podaje jeszcze raz - trochę czytelniejsze.

    Zamieniłem kawałek tego oryginalnego kodu ...
    Code:
    If po_przecinku >= 1 Then
    liczba = po_przecinku
    GoSub zamiana
    y$ = xxx$
    groszy$ = " " + y$ + " gr) "
    Else
    groszy$ = ") "
    End If
    


    ... na ten.
    Code:
    'If po_przecinku >= 1 Then
    ' liczba = po_przecinku
    ' GoSub zamiana
    ' y$ = xxx$
    ' groszy$ = " " + y$ + " gr) "
    ' Else
    ' groszy$ = ") "
    'End If
    reszta_z$ = Int(po_przecinku)
    
    If reszta_z$ >= 0 And reszta_z$ <= 9 Then
    reszta_z$ = "0" & reszta_z$
    End If
    
    If reszta_z$ = 0 Then
    reszta_z$ = "00"
    End If
    
    liczba = reszta
    GoSub zamiana
    yyyyy$ = xxx$
    słownie = "Słownie złotych: " + nazwa_md$ + nazwa_mil$ + nazwa_tys$ + yyyyy$ + " zł " + reszta_z$ + "/100 gr"
    GoTo koniec 


    Załączyć pliku nie chciałem, ponieważ większą pracę wykonał sam autor tej funkcji a szanuje prace innych, aktualnie nie posiadam pliku, przeszedłem z MSOffice + VBA na OpenOffice + Python. Bardzo prosto edytuje się makra, w MSOfice wystarczy wcisnąć ALT+F11 i znaleźć wspomniany kawałek kodu.

    Bardzo małe szanse były, że odczytam tego PM, ale jednak ...

    Pozdrawiam.
  • #19 23 Jun 2012 15:56
    Antidotum ex
    Level 9  
    Helpful post? (+2)
    Darmowe - Excel formuła do zmiany kwoty na tekst (kwota słownie) - bez makra.
    Podaję formułę, którą sam napisałem i udostępniam ją wszystkim darmowo.
    Myślę, że to nie nowość, może ktoś ma lepsze rozwiązanie - a to moja ver.
    Formuła pierwotnie napisana w OpenOffice, działa też pod Excelem (sprawdziłem).
    Maximum to: 999 999 999 999,99. Plik nie jest kodowany, można w nim grzebać, wystarczy w Arkuszu odsłonić rzędy pomiędzy J a S.
    W zał. wysyłam plik: Kwota na tekst.xls

    powodzenia i pozdrawiam
  • #20 25 Jul 2012 08:00
    AJaqubek
    Level 7  
    Helpful post? (0)
    Piękna formuła przeliczania kwoty na tekst.xls.
    Szukam właśnie czegoś takiego a sam nie mam pojęcia na tworzeniu makr. Jest tylko jedna prośba, aby zmienić zapis końcówki kwoty słownie aby wyglądał tak:
    1200,20 zł - jeden tysiąc dwieście 20/100 złotych, lub
    1200,20 zł - jeden tysiąc dwieście 20/100 zł
    Ja sam nie mam pojęcia na tworzeniu makr

    powodzenia i pozdrawiam
  • #21 25 Jul 2012 10:41
    marek003
    Level 39  
    Helpful post? (0)
    O którym przykładzie piszesz?
    W ostatnim z przedstawionych nie ma makra. Wszystko opiera się na formułach excela.
    Odkryj kolumny od K do Q a zobaczysz "silnik" funkcji zmieniającej cyfry w słownie.



    Ja z kolei korzystam z własnego rozwiązania bez makr: dodatkowego arkusza i własnych nazw. Poniżej przykład

    Końcówkę w stylu "zł" można dodać w ostatniej formule. bo nie koniecznie zawsze chodzi od razu o pieniądze. :)
  • #22 01 Aug 2012 12:44
    AJaqubek
    Level 7  
    Helpful post? (0)
    W ostatnim z przedstawionych nie ma makra. Wszystko opiera się na formułach excela.
    Odkryj kolumny od K do Q a zobaczysz "silnik" funkcji zmieniającej cyfry w słownie.



    Zaznacza kolumny i klikam "odkryj", ale prosi o hasło???

    A jak rozwiązać sprawę pisania np 30 - 40 różnych kwot słownie?
    Chcę coś takiego umieścić w arkuszach przetargowych - różne przetargi i różne ilości liczb
  • #23 01 Aug 2012 22:03
    marek003
    Level 39  
    Helpful post? (0)
    AJaqubek wrote:

    Zaznacza kolumny i klikam "odkryj", ale prosi o hasło???

    Dziwne bo u mnie nie prosi (w załączeniu "odkryty" przykład)

    AJaqubek wrote:

    A jak rozwiązać sprawę pisania np 30 - 40 różnych kwot słownie?


    Tu jednak proponuje wykorzystać makro (w VBA wprowadź je do modułu)

    Poniżej trochę przerobione pod twoje potrzeby ostatnie z makr w tym wątku.
    Przy czym przerobiłem je troszeczkę tak by walutę podawać z ręki (może być zł, może być eur, może być CHF - co zechcesz)

    Jeżeli np. liczbę masz w A1 wprowadzasz w b1 =Słownie(A1;"zł") lub =Słownie(A!;"EUR") i funkcja zwróci ci wartość słownie z końcówką zł. Jeżeli nie podasz "waluty" funkcja zwróci tylko słowną liczbę z setnymi w ułamku.


    Code:
    Function Słownie(Liczba As Variant, Optional Waluta As String) As Variant
    
    '***********************************************************
    ' Makro do przeliczania liczby na słownie
    ' (c) 2001 by Bartłomiej Sosenko
    'Troszeczkę przerobione by grosze były w ułamku i możliwością wprowadzenia dowolnej waluty (c) 2012 by marek003 :)
    
    '***********************************************************
    
    Dim LiczbaP, Wynik, Slowo, SlowoP, Slowo2, i, Przyrostki
    Dim Przyrostek, Przedrostek, Grosze, Jednostki, dziesiatki, setki
    
    
    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 = ""
    
    
    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: Przyrostki = Array(" ", " ", " ")
    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 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
    Slowo = SlowoP & Przyrostek & Slowo
    End If
    Next i
    
    
    If Liczba = 0 And Grosze = "" Then Slowo = "zero" & Slowo & " " & Waluta
    
    If Grosze <> "" Then Slowo = Slowo & Grosze & "/100" & " " & Waluta
    
    Słownie = IIf(IsEmpty(Przedrostek), Slowo, Przedrostek & Slowo)
    
    
    
    
    
    End Function



    dodane po chwili

    --------------------------------------------

    Dodałem literkę "i " do tekstu
  • #24 02 Aug 2012 10:30
    Antidotum ex
    Level 9  
    Helpful post? (0)
    Dowolną ilość kwot można użyć w prosty sposób bez VBA.
    W każdym zeszycie przekopiuj sobie do np: Arkusza1 cały arkusz "Kwota na tekst",
    następnie zaznacz komórkę z kwotą w Twoim arkuszu, zrób "Ctrl C" i wklej do komórki z kwotą w szablonie Arkusz1 przez "Ctrl V" (podmień komórki kwoty liczb). Następnie tutaj zaznacz komórkę z wybraną kwotą słownie, zrób "Ctrl C" i wklej przez "Ctrl V" do komórki z kwotą słownie w Twoim arkuszu. Wszystko działa.
    pzdr
  • #25 02 Aug 2012 14:33
    AJaqubek
    Level 7  
    Helpful post? (0)
    [quote="Antidotum ex"]Dowolną ilość kwot można użyć w prosty sposób bez VBA.
    W każdym zeszycie przekopiuj sobie do np: Arkusza1 cały arkusz "Kwota na tekst",.........."


    Przy wystawianiu faktur działa świetnie.
    Ale przy tworzonej ofercie przetargowej na każdą pozycję "słownie" trzeba więc tworzyć nowy arkusz. Jest to niewygodne przy tworzeniu ofert np. zawierającej 30 pozycji. Za 2 tygodnie znów tworzę ofertę ale już np. na 20 czy 40 pozycji. Cały czas muszę więc albo dodawać albo odejmować pozycje w ofercie, co wiąże się z wprowadzaniem bez przerwy ścieżek do wpisywania kwoty słownie i pilnowania, aby z dobrego arkusza to ściągało. W załączeniu przesyłam fragment takiego formularza OFERTY. Może coś poradzicie.
  • #26 02 Aug 2012 15:13
    jar_gogo
    Level 10  
    Helpful post? (0)
    Witam @AJaqubek
    W takim wypadku najlepszym rozwiązaniem dla Ciebie będzie właśnie makro @marek003. Działa świetnie i powinno rozwiązać Twoje problemy. Musisz się tylko stosować do jego opisu nad samym makro.

    Mam też pytanie do @marek003.
    Jako, że nie potrafię pisać makr czy mógłbyś mi pomóc troszkę je zmienić (chodzi o zapis końcowy) by zapis wyglądał następująco:

    159,37 zł
    sto pięćdziesiąt dziewięć zł 37/100 gr

    Jeśli jest to możliwe @marek003 to z góry dziękuję.
  • #27 02 Aug 2012 18:44
    AJaqubek
    Level 7  
    Helpful post? (0)
    Jako, że nie potrafię pisać makr czy mógłbyś mi pomóc troszkę je zmienić (chodzi o zapis końcowy) by zapis wyglądał następująco:

    159,37 zł
    sto pięćdziesiąt dziewięć zł 37/100 gr


    Myślę, że zapis księgowy:
    sto pięćdziesiąt dziewięć zł 37/100 gr
    nie jest poprawny, gdyż czytamy (końcówkę): trzydzieści siedem setnych groszy
  • #28 02 Aug 2012 20:11
    jar_gogo
    Level 10  
    Helpful post? (0)
    AJaqubek wrote:

    Myślę, że zapis księgowy:
    sto pięćdziesiąt dziewięć zł 37/100 gr
    nie jest poprawny, gdyż czytamy (końcówkę): trzydzieści siedem setnych groszy


    Może masz i rację w takim razie ponawiam prośbę do @marek003 ale bez skrótu "gr"
  • #29 02 Aug 2012 20:12
    marek003
    Level 39  
    Helpful post? (0)
    Proszę bardzo:
    1. wersja
    159,37 zł
    sto pięćdziesiąt dziewięć zł 37/100 gr

    dodałem literkę "i" ale jak komuś nie pasuje to należy usunąć ten warunek z jednym łącznikiem "&" w przedostatnim wierszu kodu
    IIf(Liczba = 0, "", "i ")

    Tylko kontynuowałem z opcją różnych walut
    więc funkcja wygląda tak np:

    =Słownie(wartość;"zł";"gr")

    Oczywiście jak się je pominie określenie walut - nie będą ukazywane. lub jak się je zmieni będzie efekt jak w poprzednim makro czyli
    =Słownie(wartość;;"zł") da sto pięćdziesiąt dziewięć i 37/100 zł

    Lub tak jak chcesz

    =Słownie(wartość;"zł") da sto pięćdziesiąt dziewięć zł i 37/100


    Code:
    Function Słownie(Liczba As Variant, Optional Waluta As String, Optional Waluta2 As String) As Variant
    
    '***********************************************************
    ' Makro do przeliczania liczby na słownie
    ' (c) 2001 by Bartłomiej Sosenko
    'Troszeczkę przerobione by grosze były w ułamku i możliwością wprowadzenia dowolnej waluty
    ' i jeszcze paroma zmianami(c) 2012 by marek003 :)
    
    '***********************************************************
    
    Dim LiczbaP, Wynik, Slowo, SlowoP, Slowo2, i, Przyrostki
    Dim Przyrostek, Przedrostek, Grosze, Jednostki, dziesiatki, setki
    
    
    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 = ""
    
    
    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: Przyrostki = Array(Waluta & " ", Waluta & " ", Waluta & " ")
    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 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
    Slowo = SlowoP & Przyrostek & Slowo
    End If
    Next i
    
    
    If Liczba = 0 And Grosze = "" Then Slowo = "zero" & Slowo & " " & Waluta
    
    If Grosze <> "" Then Slowo = Slowo & IIf(Liczba = 0, "", "i ") & Grosze & "/100" & " " & Waluta2
    
    Słownie = IIf(IsEmpty(Przedrostek), Slowo, Przedrostek & Slowo)
    
    
    
    
    
    End Function



    Poniżej
    2 wersja
    159,37 zł
    sto pięćdziesiąt dziewięć zł i 37 gr

    Też z opcją walut czyli zapis funkcji
    =Słownie(wartość;"zł";"gr")

    Code:
    Function Słownie(Liczba As Variant, Optional Waluta As String, Optional Waluta2 As String) As Variant
    
    '***********************************************************
    ' Makro do przeliczania liczby na słownie
    ' (c) 2001 by Bartłomiej Sosenko
    'Troszeczkę przerobione by grosze były w ułamku i możliwością wprowadzenia dowolnej waluty
    ' i jeszcze paroma zmianami(c) 2012 by marek003 :)
    
    '***********************************************************
    
    Dim LiczbaP, Wynik, Slowo, SlowoP, Slowo2, i, Przyrostki
    Dim Przyrostek, Przedrostek, Grosze, Jednostki, dziesiatki, setki
    
    
    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 = ""
    
    
    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: Przyrostki = Array(Waluta & " ", Waluta & " ", Waluta & " ")
    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 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
    Slowo = SlowoP & Przyrostek & Slowo
    End If
    Next i
    
    
    If Liczba = 0 And Grosze = "" Then Slowo = "zero" & Slowo & " " & Waluta
    
    If Grosze <> "" Then Slowo = Slowo & IIf(Liczba = 0, "", "i ") & Grosze & " " & Waluta2
    
    Słownie = IIf(IsEmpty(Przedrostek), Slowo, Przedrostek & Slowo)
    
    
    
    
    
    End Function
  • #30 02 Aug 2012 21:53
    jar_gogo
    Level 10  
    Helpful post? (0)
    @marek003
    strasznie, ale to strasznie Ci dziękuję :D

    Dodano po 1 [godziny] 31 [minuty]:

    @AJaqubek
    W załączeniu przesyłam Twój plik wzbogacony o makro @marek003 i dzięki jego pomocy ja Tobie też mogłem pomóc (oczywiście jeśli sprawdzisz i stwierdzisz, że o to Ci chodziło). Pierwszy to spakowany .xlsm z obsługą makr (dla execel-a 2007 i wzwyż). Jako, że rozszerzenie .xlsm jest póki co niedozwolone musiałem spakować. Drugi to rozszerzenie .xls (dla execel-a 2003).
    Narka
Mouser  Search 4 million + Products
Browse Products