Nowa wersja funkcji Slownie ma drugi parametr, który określa w jakiej postaci mają być grosze (zamiast True można wpisać 1 a zamiast False – 0)
Nawiasem mówiąc im nowszy WordPress tym gorszy do prowadzenia blogu programistycznego. Nie da się już użyć wtyczki do kolorowania kodu bez popsucia kodu 🙁
Wpisuje się to niestety w ogólny trend totalnego obniżania jakości i zarzucania użytkownika masą zbędnych i irytujących funkcji
Sytuację ratuje na szczęście wtyczka Classic Editor przywracająca starszą wersję edytora…
Option Explicit Function Slownie(Kwota As Variant, UlamkoweGrosze As Boolean) As String '================================== ' UWAGA! Funkcja wymaga obu funkcji ' prywatnych zamieszczonych poniżej '================================== Const WERSJA As String = _ "Funkcja Słownie v.1.03 (Akademia-VBA.pl)" Dim Opis(19) As String Dim DziesOpis(2 To 10) As String Dim SetOpis(1 To 9) As String Dim Zlotowki As String Dim Grosze As String Dim TrojkaZl As String Dim TrojkaTys As String Dim TrojkaMln As String Dim wynikGrosze As String Dim wynikZlote As String Dim Ujemna As Boolean On Error GoTo Obsluga 'sprawdzenie czy puste If IsNull(Kwota) Or IsEmpty(Kwota) Then Slownie = "# Brak kwoty!" Exit Function End If 'sprawdzenie czy liczba If Not IsNumeric(Kwota) Then Slownie = "# Nieprawidłowy typ wartości!" Exit Function End If 'gdy ujemna If Kwota < 0 Then Ujemna = True Kwota = -Kwota End If 'konwersja na stringi Zlotowki = CStr(Int(Kwota)) Grosze = CStr(Kwota - Int(Kwota)) 'sprawdzenie, czy nie za duża, max 99 mln If Len(Zlotowki) > 9 Then Slownie = "# Kwota za duża, max 999 mln!" Exit Function End If 'ewentualne zaokrąglenie do 2 msc po przecinku 'tu drobna poprawka stąd wersja 1.01 'było ...= CStr(Round(CDbl(Grosze) * 100, 2)) If Len(Grosze) > 2 Then Grosze = CStr(Round(CDbl(Grosze), 2) * 100) End If 'kod zasadniczy '============== Select Case Len(Zlotowki) Case 1 To 3 wynikZlote = Trojka(Zlotowki) & _ OpisRzeduWielkosci(CLng(Zlotowki), "zł", False) Case 4 To 6 TrojkaZl = Right(Zlotowki, 3) TrojkaTys = Left(Zlotowki, Len(Zlotowki) - 3) wynikZlote = Trojka(TrojkaTys) & _ OpisRzeduWielkosci(CLng(TrojkaTys), "tys", True) _ & " " & Trojka(TrojkaZl) & _ OpisRzeduWielkosci(CLng(TrojkaZl), "zł", True) Case 7 To 9 TrojkaZl = Right(Zlotowki, 3) TrojkaTys = Mid(Zlotowki, Len(Zlotowki) - 5, 3) TrojkaMln = Left(Zlotowki, Len(Zlotowki) - 6) wynikZlote = Trojka(TrojkaMln) & _ OpisRzeduWielkosci(CLng(TrojkaMln), "mln", True) _ & " " & Trojka(TrojkaTys) & _ OpisRzeduWielkosci(CLng(TrojkaTys), "tys", True) _ & " " & Trojka(TrojkaZl) & _ OpisRzeduWielkosci(CLng(TrojkaZl), "zł", True) End Select If UlamkoweGrosze Then wynikGrosze = Format(Grosze, "00") & "/100" Else wynikGrosze = Trojka(Grosze) & _ OpisRzeduWielkosci(CLng(Grosze), "gr", False) If wynikGrosze = "" Then wynikGrosze = "zero groszy" End If If wynikZlote = "" Then wynikZlote = "zero złotych" Slownie = IIf(Ujemna, "minus ", "") & _ Trim(wynikZlote & " " & wynikGrosze) Exit Function Obsluga: MsgBox Err & " - " & Err.Description, vbCritical, WERSJA End Function Private Function OpisRzeduWielkosci( _ Liczba As Long, RzadWielkosci As String, _ WiekszeTysiac As Boolean) As String Dim JestZero As Boolean Dim DwieOstatnie As Long Dim Ostatnia As Long If Liczba = 0 Then If WiekszeTysiac Then If RzadWielkosci = "zł" Then OpisRzeduWielkosci = "złotych" End If Else OpisRzeduWielkosci = "" End If Exit Function End If DwieOstatnie = CLng(Right(CStr(Liczba), 2)) Ostatnia = CLng(Right(CStr(Liczba), 1)) Select Case RzadWielkosci Case "gr" Select Case DwieOstatnie Case 0, 5 To 19 OpisRzeduWielkosci = " groszy" Case 1 OpisRzeduWielkosci = " grosz" Case 2 To 4 OpisRzeduWielkosci = " grosze" Case Is > 19 Select Case Ostatnia Case 0, 1, Is > 4 OpisRzeduWielkosci = " groszy" Case 2 To 4 OpisRzeduWielkosci = " grosze" End Select End Select Case "zł" Select Case DwieOstatnie Case 0, 5 To 19 OpisRzeduWielkosci = " złotych" Case 1 OpisRzeduWielkosci = " złoty" Case 2 To 4 OpisRzeduWielkosci = " złote" Case Is > 19 Select Case Ostatnia Case 0, 1, Is > 4 OpisRzeduWielkosci = " złotych" Case 2 To 4 OpisRzeduWielkosci = " złote" End Select End Select Case "tys" Select Case DwieOstatnie Case 0, 5 To 19 OpisRzeduWielkosci = " tysięcy" Case 1 OpisRzeduWielkosci = " tysiąc" Case 2 To 4 OpisRzeduWielkosci = " tysiące" Case Is > 19 Select Case Ostatnia Case 0, 1, Is > 4 OpisRzeduWielkosci = " tysięcy" Case 2 To 4 OpisRzeduWielkosci = " tysiące" End Select End Select Case "mln" Select Case DwieOstatnie Case 0, 5 To 19 OpisRzeduWielkosci = " milionów" Case 1 OpisRzeduWielkosci = " milion" Case 2 To 4 OpisRzeduWielkosci = " miliony" Case Is > 19 Select Case Ostatnia Case 0, 1, Is > 4 OpisRzeduWielkosci = " milionów" Case 2 To 4 OpisRzeduWielkosci = " miliony" End Select End Select End Select End Function Private Function Trojka(strLiczba As String) As String Dim lngLiczba As Long Dim lngOstatnia As Long Dim lngDwieOstatnie As Long Dim Opis(19) As String Dim DziesOpis(10) As String Dim SetOpis(9) As String If CLng(strLiczba) = 0 Then Trojka = "" Exit Function End If Opis(0) = "zero" Opis(1) = "jeden" Opis(2) = "dwa" Opis(3) = "trzy" Opis(4) = "cztery" Opis(5) = "pięć" Opis(6) = "sześć" Opis(7) = "siedem" Opis(8) = "osiem" Opis(9) = "dziewięć" Opis(10) = "dziesięć" Opis(11) = "jedenaście" Opis(12) = "dwanaście" Opis(13) = "trzynaście" Opis(14) = "czternaście" Opis(15) = "piętnaście" Opis(16) = "szesnaście" Opis(17) = "siedemnaście" Opis(18) = "osiemnaście" Opis(19) = "dziewiętnaście" DziesOpis(0) = "zero" DziesOpis(1) = "dziesięć" DziesOpis(2) = "dwadzieścia" DziesOpis(3) = "trzydzieści" DziesOpis(4) = "czterdzieści" DziesOpis(5) = "pięćdziesiąt" DziesOpis(6) = "sześćdziesiąt" DziesOpis(7) = "siedemdziesiąt" DziesOpis(8) = "osiemdziesiąt" DziesOpis(9) = "dziewięćdziesiąt" SetOpis(0) = "zero" SetOpis(1) = "sto" SetOpis(2) = "dwieście" SetOpis(3) = "trzysta" SetOpis(4) = "czterysta" SetOpis(5) = "pięćset" SetOpis(6) = "sześćset" SetOpis(7) = "siedemset" SetOpis(8) = "osiemset" SetOpis(9) = "dziewięćset" lngLiczba = CLng(strLiczba) 'tu policzymy ostatnią lngOstatnia = CLng(Right(strLiczba, 1)) Select Case lngLiczba Case Is < 20 Trojka = Opis(lngLiczba) Case Is < 100 If lngLiczba Mod 10 = 0 Then Trojka = DziesOpis(lngLiczba / 10) Else Trojka = DziesOpis((lngLiczba - lngOstatnia) / 10) _ & " " & Opis(lngOstatnia) End If Case Else 'trzycyfrowa If lngLiczba Mod 100 = 0 Then Trojka = SetOpis(lngLiczba / 100) Else 'tu policzymy dwie ostatnie lngDwieOstatnie = CLng(Right(strLiczba, 2)) If lngLiczba Mod 10 = 0 Then Trojka = SetOpis((lngLiczba - lngDwieOstatnie) / 100) _ & " " & DziesOpis(lngDwieOstatnie / 10) Else If lngDwieOstatnie < 20 Then Trojka = SetOpis((lngLiczba - lngDwieOstatnie) / 100) _ & " " & Opis(lngDwieOstatnie) Else Trojka = SetOpis((lngLiczba - lngDwieOstatnie) / 100) _ & " " & DziesOpis((lngDwieOstatnie - lngOstatnia) / 10) _ & " " & Opis(lngOstatnia) End If End If End If End Select End Function |
Zastosowałem tę istotnie przydatną funkcję. Teraz jest ona dostępna jako:
fx -> Wstawianie -> Zdefiniowane przez użytkownika -> Slownie
Działa wspaniale !!!
Jeśli mógłbym coś zasugerować, to prośba o dodanie podpowiedzi podczas na bieżąco wprowadzanych argumentów: Slownie(arg1;arg2), aby nie zapomnieć wprowadzić argumentu decydującego o formacie groszy.
Dzięki za dobre słowo 🙂
Podpowiadanie argumentów nie jest niestety takie proste
Tu więcej o tym
https://www.officeblog.pl/vba-excel-tworzenie-opisow-pomocy-dla-wlasnych-funkcji-udf/
Dzień dobry,
mam problem z tą funkcją. O ile z poprzednio dodanym kodem zapisującym całą kwotę słownie wszystko super działa, to przy wprowadzeniu kodu by zapisać grosze ułamkami ciągle mam błąd. Kwota jest zapisana w formie 2135,35 zł i format komórki ustawiony mam na walutowy. Co robię źle?
Hej
A czy podajesz drugi parametr?
=Slownie(A1;0) – da wynik bez ułamka
dwa tysiące sto trzydzieści pięć złotych trzydzieści pięć groszy
=Slownie(A1;1) – da wynik z ułamkiem
dwa tysiące sto trzydzieści pięć złotych 35/100
Dziękuję 😀 faktycznie to przegapiłam, a jak już się za dużo wymyśla to najprostsze rozwiązania są niewidoczne 😀 Teraz jest idealnie 😀
Cześć, kapitalna funkcja,
tylko dla kwot typu 0,23 zł – zwraca wynik: ” 23/100 ” – bez informacji że zero złotych ;P
Zrobione 🙂
Witam, tego szukałem ale w wyliczaniu groszy potrafi przekłamać.
Jak mam w komórce wartość zaokrągloną do 2 miejsc po przecinku ale faktycznie są trzy to funkcja zwraca opis z „groszem mniej”
Np.
Liczba w komórce po wyliczeniach 22,225, excel zwraca 22,23
Formula SLOWNIE: dwadzieścia dwa złote 22/100
użyj wcześniej funkcji Excela zaokr (round) na wyniku który podajesz jako argument funkcji
czemu pokazuje #value! ?