Jak na razie to największy kawałek kodu na tej stronie. Funkcja Slownie, czyli zamieniająca kwotę na jej słowny odpowiednik nie jest dostępna w Excelu ani w żadnej innej aplikacji Microsoft Office (o ile mi wiadomo).
I tu korekta (jak sądzę). W komentarzu pod tym artykułem znajduje się funkcja działająca w SQL Server Reporting Services. Komentarz autorstwa Pana Adama.
Oczywiście w Sieci można znaleźć wiele przykładów jej implementacji ale cóż warta byłaby strona o VBA, gdyby jej tu nie można było znaleźć. Wszelkie wytknięte błędy i konstruktywne uwagi krytyczne będą mile widziane (dwa błędy już zostały wykryte i poprawione). Funkcja korzysta z dwóch pomocniczych funkcji prywatnych, bez których nie będzie działać. Oto kod:
Option Explicit Function Slownie(Kwota As Variant) As String '================================== ' UWAGA! Funkcja wymaga obu funkcji ' prywatnych zamieszczonych poniżej '================================== Const WERSJA As String = _ "Funkcja Słownie v.1.02 (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 wynikGrosze = Trojka(Grosze) & _ OpisRzeduWielkosci(CLng(Grosze), "gr", False) If wynikGrosze = "" Then wynikGrosze = "zero groszy" 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 |
OstLiczba = CLng(Right(CStr(Liczba), 1))
W funkcji „OpisRzeduWielkosci” należy zmienić w powyższym fragmencie 1 na 2, ponieważ dla liczb większych niż 100 niepoprawnie odmienia słowo „złote” (bez zmiany otrzymujemy „113 złote”, „213 złote”, itd.).
witam mam problem po wklejeniu kodu wyskakuje mi blad
SyntaxError: Unexpected identifier (wiersz 2, plik „makra.gs”)Zamknij
rzeczywiście masz rację, odkryłeś błąd. Jego rozwiązanie nie było niestety aż tak proste jak proponowałeś, ale dzięki za testy. Zamieściłem już poprawiony kod
Co prawda nie jest to VBA tylko VB.NET ale skoro Pan Adam tak się wysilił to może się komuś przyda funkcja Slownie na potrzeby SQL Server Reporting Services (jeszcze nie testowałem ale wygląda sensownie)
Poniżej cytuję Pana Adama
[cc lang=”vb”]
Do reporting services funkcja do zamiany kwoty na słownie
Public Shared Function changeToWords(ByVal numb As [String]) As [String]
Dim val As [String] = „”, wholeNo As [String] = numb, points As [String] = „”, andStr As [String] = „”, pointStr As [String] = „”
Dim endStr As [String] = „”
Try
Dim decimalPlace As Integer = numb.IndexOf(„.”)
If decimalPlace > 0 Then
wholeNo = numb.Substring(0, decimalPlace)
points = numb.Substring(decimalPlace + 1)
andStr = ” ”
pointStr = translateCents(points)
Else andStr = ” 00/100 zł”
End If
val = [String].Format(„{0} {1}{2} {3}”, translateWholeNumber(wholeNo).Trim(), andStr, pointStr, endStr)
Catch
End Try
Return val
End Function
Private Shared Function translateWholeNumber(ByVal number As [String]) As [String]
Dim word As String = „”
Try
Dim beginsZero As Boolean = False
'tests for 0XX
Dim isDone As Boolean = False
'test if already translated
Dim dblAmt As Double = (Convert.ToDouble(number))
'if ((dblAmt > 0) && number.StartsWith(„0”))
If dblAmt > 0 Then
'test for zero or digit zero in a nuemric
beginsZero = number.StartsWith(„0”)
Dim numDigits As Integer = number.Length
Dim pos As Integer = 0
'store digit grouping
Dim place As [String] = „”
'digit grouping name:hundres,thousand,etc…
Select Case numDigits
Case 1
'ones’ range
word = ones(number)
isDone = True
Exit Select
Case 2
'tens’ range
word = tens(number)
isDone = True
Exit Select
Case 3
'hundreds’ range
word = sto(number)
isDone = True
Exit Select
'thousands’ range
Case 4, 5, 6
pos = (numDigits Mod 4) + 1
Select Case numDigits
Case 4
place = tysiac(number.Substring(0, 1),1)
Exit Select
Case 5
place = tysiac(number.Substring(1, 1),0)
Exit Select
Case 6
place = tysiac(number.Substring(2, 1),0)
Exit Select
End Select
Exit Select
'millions’ range
Case 7, 8, 9
pos = (numDigits Mod 7) + 1
Select Case numDigits
Case 7
place = milion(number.Substring(0, 1),1)
Exit Select
Case 8
place = milion(number.Substring(1, 1),0)
Exit Select
Case 9
place = milion(number.Substring(2, 1),0)
Exit Select
End Select
Exit Select
Case 10
'Billions’s range
pos = (numDigits Mod 10) + 1
place = ” miliard ”
Exit Select
Case Else
'add extra case options for anything above Billion…
isDone = True
Exit Select
End Select
If Not isDone Then
'if transalation is not done, continue…(Recursion comes in now!!)
word = translateWholeNumber(number.Substring(0, pos)) + place + translateWholeNumber(number.Substring(pos))
'check for trailing zeros
If beginsZero Then
word = ” and ” & word.Trim()
End If
End If
'ignore digit grouping names
If word.Trim().Equals(place.Trim()) Then
word = „”
End If
End If
Catch
End Try
Return word.Trim()
End Function
Private Shared Function tysiac(ByVal digit As Integer, ByVal No As Integer) As [String]
Dim name As [String] = Nothing
Select Case digit
Case 1
If No.Equals(1) Then
name = ” tysiąc ”
Else
name = ” tysiecy ”
End If
Exit Select
Case 2, 3, 4
name = ” tysiące ”
Exit Select
Case 5,6,7,8,9
name = ” tysięcy ”
Exit Select
End Select
Return name
End Function
Private Shared Function milion(ByVal digit As Integer, ByVal No As Integer) As [String]
Dim name As [String] = Nothing
Select Case digit
Case 1
If No.Equals(1) Then
name = ” milion ”
Else
name = ” milionów ”
End If
Exit Select
Case 2, 3, 4
name = ” miliony ”
Exit Select
Case 5,6,7,8,9
name = ” milionów ”
Exit Select
End Select
Return name
End Function
Private Shared Function sto(ByVal digit As [String]) As [String]
Dim digt As Integer = Convert.ToInt32(digit)
Dim name As [String] = Nothing
Select Case digt
Case 100
name = „sto”
Exit Select
Case 200
name = „dwieście”
Exit Select
Case 300
name = „trzysta”
Exit Select
Case 400
name = „czterysta”
Exit Select
Case 500
name = „pięćset”
Exit Select
Case 600
name = „sześćset”
Exit Select
Case 700
name = „siedemset”
Exit Select
Case 800
name = „osiemset”
Exit Select
Case 900
name = „dziewięćset”
Exit Select
Case Else
If digt > 0 Then
name = (sto(digit.Substring(0, 1) & „00”) & ” „) + (tens(digit.Substring(1, 1) & „0”) & ” „) + ones(digit.Substring(2))
End If
Exit Select
End Select
Return name
End Function
Private Shared Function tens(ByVal digit As [String]) As [String]
Dim digt As Integer = Convert.ToInt32(digit)
Dim name As [String] = Nothing
Select Case digt
Case 10
name = „dziesięć”
Exit Select
Case 11
name = „jedenaście”
Exit Select
Case 12
name = „dwanaście”
Exit Select
Case 13
name = „trzynaście”
Exit Select
Case 14
name = „czternaście”
Exit Select
Case 15
name = „piętnaście”
Exit Select
Case 16
name = „szesnaście”
Exit Select
Case 17
name = „siedemnaście”
Exit Select
Case 18
name = „osiemnaście”
Exit Select
Case 19
name = „dziewiętnaście”
Exit Select
Case 20
name = „dwadzieścia”
Exit Select
Case 30
name = „trzydzieści”
Exit Select
Case 40
name = „czterdzieści”
Exit Select
Case 50
name = „pięćdziesiąt”
Exit Select
Case 60
name = „sześćdziesiąt”
Exit Select
Case 70
name = „siedemdziesiąt”
Exit Select
Case 80
name = „osiemdziesiąt”
Exit Select
Case 90
name = „dziewięćdziesiąt”
Exit Select
Case Else
If digt > 0 Then
name = (tens(digit.Substring(0, 1) & „0”) & ” „) + ones(digit.Substring(1))
End If
Exit Select
End Select
Return name
End Function
Private Shared Function ones(ByVal digit As [String]) As [String]
Dim digt As Integer = Convert.ToInt32(digit)
Dim name As [String] = „”
Select Case digt
Case 1
name = „jeden”
Exit Select
Case 2
name = „dwa”
Exit Select
Case 3
name = „trzy”
Exit Select
Case 4
name = „cztery”
Exit Select
Case 5
name = „pięć”
Exit Select
Case 6
name = „sześć”
Exit Select
Case 7
name = „siedem”
Exit Select
Case 8
name = „osiem”
Exit Select
Case 9
name = „dziewięć”
Exit Select
End Select
Return name
End Function
Private Shared Function translateCents(ByVal cents As [String]) As [String]
Dim cts As [String] = „”, digit As [String] = „”, engOne As [String] = „”
For i As Integer = 0 To cents.Length – 1
digit = cents(i).ToString()
cts += „” & digit
Next
If cents.Length.Equals(1) Then
cts += „0”
End If
If cents.Length.Equals(0) Then
cts += „00”
End If
cts += „/100 zł”
Return cts
End Function
[/cc]
taki drobiazg 🙂
debug.Print Slownie(999999999.-1)
dziewięćset dziewięćdziesiąt dziewięć milionów dziewięćset dziewięćdziesiąt dziewięć tysięcy dziewięćset dziewięćdziesiąt osiem złotych
🙂
Skorzystałem, dziękuję. Przydałaby się jeszcze wersja pod dowolną walutę typu:
sto jedenaście EUR 35/100.
Cześć,
czy w jakiś prosty sposób da się zamienić by do kwoty, którą jest liczba całkowita było dopisywane „zero groszy”.
Czy da zmienić się zapis groszy na format „gr/100”?
Kod, który jest na tej stronie jest bardzo dobrej jakości w porównaniu do tych zamieszczonych przez innych użytkowników, natomiast brakuje mi tej opcji.
Pozdrawiam
Chciałbym skorzystać z tego makra, ale niestety nie potrafię tego przenieść do mojego excela 🙁
to może pomóc
http://akademia-vba.pl/ogolne/jak-skorzystac-z-kodu-vba-znalezionego-w-internecie/
Może ktoś podpowiedzieć jak powyższy kod zaimplementować do sql-a?
Witam, czy wystarczy skopiować kod i wkleić w edytorze vba żeby działał? Wklejam wszystko w jeden moduł i nie działa, zamiast wyniku wyswietla mi sie #Błąd ;/ Proszę o pomoc 🙂
tak, wystarczy utworzyć skoroszyt z obsługą makr, w nim moduł publiczny i wkleić do niego kod
Pomoc:
http://akademia-vba.pl/excel-vba/jak-zaczac-programowanie-w-vba-w-excelu-2010/
http://akademia-vba.pl/ogolne/jak-skorzystac-z-kodu-vba-znalezionego-w-internecie/
Podpinam się pod kolegę. Jak stworzyć dopisek „zero groszy”?
zmodyfikowałem kod – teraz będzie „zero groszy”
Kod się sprawdza doskonale. Bardzo mi pomógł i dziękuję twórcy za udostępnienie. Od razu dodam, że w momencie, gdy zaczął go obsługiwać pechowiec, czyli ja 😀 od razu wyskoczył mi byk. Oczywiście mój, na który ewidentnie twórca nie był przygotowany 😀 Nie wprowadziłam zaokrągleń kwot, więc wynik formuły był dokładnie 179.9989. Funkcja wówczas podaje wartość słownie „sto siedemdziesiąt dziewięć złotych i sto groszy”… Może warto wprowadzić zaporę przed zdolnościami takich, jak ja 😀
dzięki za info, spróbuję poprawić w wolnej chwili
Hej
Troszkę mi zajęła ta odpowiedź 🙂
Wystarczy dopisać zaokrąglenie do 2 miejsc po przecinku, przed konwersją na stringi
'zabezpieczenie przed liczbą groszy >2 miejsca po przecinku
Kwota = Round(Kwota, 2)
'konwersja na stringi….
Panie Darku
nie mogę znależć modułu
do zapisu w wersji np 20/100
dla groszy.
niestety nie ma takiej funkcjonalności 🙁
Super funkcja, bardzo dziękuje.
Ja również mam problem, kwota 1100,00 słownie brzmi „jeden tysiąc dziewięćdziesiąt dziewięć złoty sto groszy”.
da się to jakoś poprawić?
podeślij proszę na mój gmail arkusz z tym błędem, ponieważ u mnie nie występuje
Witam, u mnie po zaimplementowaniu kodu i próbie użycia, pojawia się błąd. Na nowo otwiera się okno VBA i prosi o poprawę tego fragmentu:
'gdy ujemna
If Kwota < 0 Then
niektóre przeglądarki przeklejają jakieś zbędne białe znaki. Trzeba je usunąć lub użyć innej przeglądarki
witam mam problem po wklejeniu kodu wyskakuje mi blad
SyntaxError: Unexpected identifier (wiersz 2, plik „makra.gs”)Zamknij
Hej
Jeżeli przeklejasz przy użyciu Internet Explorera to czasem są błędy
Lepszy jest np Chrome
Pozdrawiam
Dariusz Kolasa
niestety ten sam problem przy użyciu chrome
jeżeli to nie problem to proszę wysłać do mnie ten plik – zobaczę o co chodzi
Witam,
szukam kodu do kwoty słownie ale aby grosze były 35/100 gdzie mogę to znaleźć
prosiłabym o udostępnienie go bo kurcze mam ten drugi
Witam, czy mogłabym prosić kod dotyczący zapisu liczby w formie słownej ale żeby było 12/100 – taka forma tylko mnie interesuje
z góry będę bardzo wdzięczna
nie mam niestety czasu aby to napisać 🙁
być może to Pani się może przydać
https://brutanek.com/pobierz/download-dodatek-excel-kwota-slownie-po-angielsku.html
Dzień dobry,
Czy posiada Pan zamianę liczb na tekst w wersji angielskiej ewentualnie podpowiedź gdzie znaleźć.
Z góry dziękuję
Rysiek
Tu coś mają
https://brutanek.com/pobierz/download-dodatek-excel-kwota-slownie-po-angielsku.html
Witam.
W jaki sposób mógłbym zaimplementować kod, aby nie generował tekstu w postaci złote, złotych, groszy, grosze, itp., a jedynie sam tekst liczbowy. Przecież niekoniecznie musi być on związany tylko z „kasiorą”.
wszędzie tam gdzie masz OpisRzeduWielkosci… to musisz go usunąć. Zostawiasz same trójki
Np grosze zamiast wynikGrosze = Trojka(Grosze) & _
OpisRzeduWielkosci(CLng(Grosze), „gr”, False)
piszesz
wynikGrosze = Trojka(Grosze)
oczywiście tam gdzie złote też usuwasz i to więcej
Dzień dobry. Robię tak jak jest napisane. I co dziwne w niektórych plikach działa. Natomiast w innych pojawia się błąd #ADR!
Jaka może być tego przyczyna?
no po prostu błąd adresowania, funkcja nie ma z tym nic wspólnego, każesz Excelowi użyć adresu, który nie jest prawidłowy w danym kontekście. Poczytaj o adresowaniu w Excelu, jest tego multum w necie
Witam.
W MS Excel 2007 wszystko działa poprawnie, lecz podczas przeniesienia do darmowej wersji Office – LibreOffice jest problem.
Wyrzuca komunikat „Błąd uruchomieniowy języka BASIC. Nie ustawiono zmiennej obiektu”. Dzieje się tak jedynie podczas „konwertowania” liczb po przecinku (groszy). Podczas „konwertowania” samych złotówek jest poprawnie.
Ćwiczenie ex-855 – chodzi mi przy wyświetlaniu liczby słownie wyświetla i daje liczbę ułamkową tylko po liczbie słownie żeby pisało złotych i po liczbie ułamkowej grosze
Bardzo dziękuję autorowi i autorom poprawek.
Dla mnie, laika exce’a i „mini” przedsiębiorcy to świetna pomoc.
Dzień dobry. Mam problem z wrzuceniem danego skryptu do arkuszy kalkulacyjnych google. Wyskakuje non stop ” SyntaxError: Unexpected identifier (wiersz 2, plik „kod.gs”) „- jest to wiersz zawierający jedynie Option Explicit. Czy da się jakoś rozwiązać dany problem?
Nie znam się niestety na arkuszach google ale zawsze możesz po prostu usunąć tą linię. To jest deklaracja, nie jest konieczna do działania kodu
Niestety nieważne czy usunę dany wiersz czy nie- pokazuje mi, jakoby cały kod był błędny, a szkoda, bo nigdzie w Internecie nie można znaleźć rozwiązania tego problemu.
Witam,
wkleiłam kod do Excel ale niestety nie uzyskuje polskich liter? Jaka może być tego przyczyna?
Kodowanie polskich znaków nie zadziałało prawidłowo
Spróbuj przekleić z innej przeglądarki lub w ostateczności użyj narzędzia znajdź i zamień (Ctrl+H)
Cześć,
po zastosowaniu, zauważyłam błąd : słownie źle się wyświetla przy kwotach z jednym groszem (na drugim msc po przecinku )
np. 260,01
pokazuje jako : słownie: dwieście sześćdziesiąt złotych zero groszy
np. 297,96
pokazuje jako : słownie: dwieście dziewięćdziesiąt siedem złotych dziewięćdziesiąt pięć groszy
260,01 dwieście sześćdziesiąt złotych jeden grosz
297,96 dwieście dziewięćdziesiąt siedem złotych dziewięćdziesiąt sześć groszy
U mnie nie ma błędu 🙂
Posłałem Ci plik z kodem i wynikiem 🙂
Dzień Dobry Panu
Wszystko działa fajnie, tylko w przypadku wprowadzenia kwoty wyrażonej w groszach np. 110,50 zł wyskakuje mi błąd w LibreOfficie
Błąd uruchomieniowy języka BASIC.
Nie ustawiono zmiennej obiektu.
Exit Function
Obsluga:
MsgBox Err & ” – ” & Err.Description, vbCritical, WERSJA
End Function
Da się rozwiązać jakoś owy problem?
Z góry dziękuję za odpowiedź
Niestety aby zdiagnozować problem musiałbym zainstalować LibreOffice …
Nawet nie wiedziałem, że tam można uruchamiać makra napisane w VBA
Być może jest to kwestia braku pełnej kompatybilności LibreOffice z VBA
Panie Dariuszu,
A jak można byłoby przerobić funkcię aby nie było w niej groszy ani złotych?
Zwyczajnie czytanie liczb.
Z góry dziękuję za podpdowiedź.
Pozdrawiam,
Agnieszka
W sumie to potrzebuję aby kwoty były pisane słownie a na końcu groszowe sprawy były pokazane w ułamku czy to jest możliwe do wykonania?
np.
1150,55
Jeden tysiąć sto pięćdziesiąt 55/00
Jak Pani widzi funkcja jest dość skomplikowana. Można wszystko. Zależy od budżetu 🙂
Witam,
po implementacji funkcja działa doskonale, z jednym problemem. Polskie znaki dialektyczne są zastępowane przez symbole.
Jest jakiś sposób, żeby pojawiały się polskie znaki?
prawdopodobnie chodzi o ustawienia kodowania znaków w przeglądarce. Proszę spróbować użyć innej przeglądarki
Czy jest dostępna dla EURO?
nie ma
Ale posiadając kod źródłowy możesz pokombinować
Wszystkie złote zamień na Euro a grosze na centy 🙂
Po kilku latach znowu znalazłem ten kod 🙂
Po pierwsze BARDZO dziękuję za jego publikację!
A po drugie – wyskakuje mi błąd w VBA:
>invalid outside procedure<
Tworzę nowy moduł i kopiuję cały kod (łącznie z prywatnymi podfunkcjami).
Excel 2016.
Jeżeli Pan (lub ktoś z czytających) wie jak to rozwiązać to będę zobowiązany 🙂
Kiedyś nie miałem tego problemu. Chyba. Nie za bardzo wiem jak to rozwiązać.
Przekopiowałem przed chwilą dla sprawdzenia w przeglądarce Chrome
Wersja 108.0.5359.125 (Oficjalna wersja) (64-bitowa)
I wszystko działa
Może nie wklejasz do modułu publicznego?
Otrzymałem Pańskiego maila. Serdecznie dziękuję!
Może rzeczywiście coś z kopiowaniem z przeglądarki (używam Firefoxa).
Hej,
Zrobiłam wszystko krok po kroku niestety wyskakuje mi finalnie bład:
compile error:
Invalid outsideprocedure.
Co zrobiłam nie tak ?
może coś więcej było skopiowane niż kod?
Dokładnie mam ten sam problem.
Tekst został prawidłowo skopiowany.
Wiem z czego wynika błąd. Z kodu musiałem usunąć „puste” znaki, entery lub spacje.
skorzystałem z funkcji znajdź i zamień.
Teraz działa
Excel 365
Witam,
Mam pytanko czy jest szansa na dostęp do kodu dla zapisu słownie tj z końcówka 00/100
Wrzuciłem nową wersję, ale nie wiem czy dokładnie o to chodziło
Dzień dobry
Jestem „mocnym średniakiem” jeśli chodzi o exel…
Ale z każdym dniem ten program coraz bardziej mi się podoba ,ma wiele możliwości .
Panie @Dariusz Kolasa dziękuję!!! i podziwiam,że po 13 latach nadal Pan odpowiada na komentarze.
Chapeau bas!!!! 🙂
Wiem, że to dziwne ale ja nadal lubię ten język za to że jest prosty a ma duże możliwości. I za świetny edytor, który po 30 latach jest wciąż jednym z najlepszych. Lubię też ludzi, którzy chcą poznać ten język 🙂
Skrypt działa. Jednakże zmieniając kwotę w komórce na inną, w kolejnej komórce z formułą odnoszącą się do VBA pojawia się komunikat #NAZWA?
Idzie to jakoś obejść? Aby swobodnie edytować kwoty i za każdym razem nie wczytywać skryptu od nowa?
Skrypt działa tylko wtedy, gdy jest otwarty plik, który go zawiera. Jeżeli to ma działać w każdym pliku to trzeba skrypt wgrać do pliku PERSONAL (Skoroszyt makr osobistych) lub utworzyć i zainstalować dodatek z tym skryptem.
Hej
Wrzuciłem do Personal.xlsb, ale mi nie trybi, w czystym pliku zapisanym .xlsm działa bez zarzutu.
Nie używam Personala raczej robię własne dodatki. Ale w sumie nie wiem czemu by miało nie działać. Personale są czasem dwa w różnych lokalizacjach. Trzeba pokombinować
Cześć,
Mam problem i nie wiem jak użyć tego kodu w VBA. Wyskakują mi przeróżne błędy. Używam VBA od Microsoftu, tworzę nowy projekt jako dodatek do excela, wklejam go i przy kompilacji wyskakuje mi kilka błędów których nie da się poprawić bez całkowitego zmieniania kodu… co poprawię jeden błąd to pojawia się kilka innych. Może używam do tego złego programu? Jestem w tym totalnie zielony. Myślałem że sobie bez problemu poradzę bo już robiłem podobne rzeczy tego typu, a tutaj wychodzi kaplica.
Pozdrawiam!
spróbuj przekleić z innej przeglądarki
przekleiłem dzisiaj z Chrome Wersja 114.0.5735.199 (Oficjalna wersja) (64-bitowa)
i działa bez problemu. Przeklejasz do modułu standardowego (Module) i zapisujesz plik jako .xlsm
Hej makro działa, ale nie wyświetla „ąęćźżł itd.”tylko krzaczki zamiast nich. Język excela oraz systemu jest po polsku, co zrobić? Proszę o pomoc
masz coś źle ustawione w Windows – sprawdź język, ustawienia regionalne itp
Dzień dobry,
chciałbym pociągnąć temat LibreOffice. Błąd w dalszym ciągu wyskakuje.
Błąd uruchomieniowy języka BASIC.
Nie ustawiono zmiennej obiektu.
Exit Function
Obsluga:
MsgBox Err & ” – ” & Err.Description, vbCritical, WERSJA
End Function
Jest jakaś możliwość uruchomienia makra w tym programie?
Może ktoś pomoże koledze?
Ja nie mam żadnego doświadczenia z LibreOffice
Pozdrawiam
DK
powinno działać pod LibreOffice
Option Explicit
Function Slownie(Kwota As Variant) As String
'==================================
’ UWAGA! Funkcja wymaga obu funkcji
’ prywatnych zamieszczonych poniżej
'==================================
Const WERSJA As String = _
„Funkcja Słownie v.1.02 (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 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(MyRound(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
wynikGrosze = Trojka(Grosze) & _
OpisRzeduWielkosci(CLng(Grosze), „gr”, False)
If wynikGrosze = „” Then wynikGrosze = „zero groszy”
Slownie = IIf(Ujemna, „minus „, „”) & _
Trim(wynikZlote & ” ” & wynikGrosze)
Exit Function
Obsluga:
MsgBox Error$ & ” – ” & Error$, 16, 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(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(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)
lngOstatnia = CLng(Right(strLiczba, 1))
lngDwieOstatnie = CLng(Right(strLiczba, 2))
If Len(CStr(lngLiczba)) = 1 Then
Trojka = Opis(lngLiczba)
ElseIf Len(CStr(lngLiczba)) = 2 Then
If lngLiczba 0 Then
Trojka = Trojka & ” ” & Opis(lngOstatnia)
End If
End If
ElseIf Len(CStr(lngLiczba)) = 3 Then
Trojka = SetOpis(lngLiczba \ 100)
If lngDwieOstatnie 0 Then
Trojka = Trojka & ” ” & Opis(lngDwieOstatnie)
End If
Else
Trojka = Trojka & ” ” & DziesOpis(lngDwieOstatnie \ 10)
If lngOstatnia > 0 Then
Trojka = Trojka & ” ” & Opis(lngOstatnia)
End If
End If
End If
End Function
Private Function MyRound(Number As Double, DecimalPlaces As Integer) As Double
MyRound = Int(Number * 10 ^ DecimalPlaces + 0.5) / 10 ^ DecimalPlaces
End Function
czyli problemem była funkcja Round?
To i też na Err się wywalał.
Cześć, prośba o pomoc. Co zrobić jak formuła nie pokazuje polskich znaków np.jeden z³oty zero groszy, 5 piêæ z³otych zero groszy
Sprawdź ustawienia językowe w Excelu i w Windows
Dzień dobry,
Czy jest możliwość, aby cyfry były wyświetlane słownie bez złoty ani groszy ?
Chyba wystarczy z kodu wyrzucić wszystkie wystąpienia „złotych” i „groszy” ale czy to będzie wtedy czytelne?
Sprawdzę i dam znać, ponieważ potrzebuję tylko, aby automatycznie excel wpisywał ilość stron słownie.
Np.:
liczba stron cyfra: 3
liczba stron słownie: trzy
Udało sie, dziękuje za szybką odpowiedź i pomoc 🙂
Super, powodzenia 🙂
skopiowany plik i jest ok ale niestety zamiast odczytu 115 zł czyta i wpisuje
sto czternaście zloty i 100 groszy … jak naprawić ten błąd???
u mnie
sto piętnaście złotych 00/100
ale spróbuję dopisać aby przy całkowitych pomijał grosze