X

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

bkroy 19 May 2009 22:44
  • #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? (+1)
    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? (+1)
    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
  Search 4 million + Products
Browse Products