Wątek przeniesiony 2021-09-16 10:09 z Inne języki programowania przez cerrato.

słownie VBA

0

witam jak zrobić żeby trzy kwoty były słownie.Zmieniam kwotę i ona jest automatycznie słownie

0

jak zrobić żeby dla trzech kwot obliczało jedną oblicza prawidłowo

' (c) 2011 [email protected]
' freeware
'
Option Explicit

Const zerogroszy = True

Sub SlownieFn()
Dim i As Integer
Dim kwota As Double
Dim r As Range
With ActiveDocument
For i = 1 To 32
If .Bookmarks.Exists("kwota" & i) Then
Set r = .Bookmarks("kwota" & i).Range
kwota = r
.Variables("slownie" & i).Value = Slownie(kwota)
End If
Next i
.Fields.Update
End With
End Sub

Function Ad(ByVal s1 As String, ByVal s2 As String) As String
If (s1 <> "") And (s2 <> "") Then Ad = s1 + " " + s2 Else Ad = s1 + s2
End Function

Function liczba(w As Integer, s As String) As String
Dim d1, d2, d3, dx
d1 = Array("", "jeden", "dwa", "trzy", "cztery", "pięć", "sześć", "siedem", "osiem", "dziewięć")
d2 = Array("", "dziesięć", "dwadzieścia", "trzydzieści", "czterdzieści", "pięćdziesiąt", "sześćdziesiąt", "siedemdziesiąt", "osiemdziesiąt", "dziewięćdziesiąt")
d3 = Array("", "sto", "dwieście", "trzysta", "czterysta", "pięćset", "sześćset", "siedemset", "osiemset", "dziewięćset")
dx = Array("dziesięć", "jedenaście", "dwanaście", "trzynaście", "czternaście", "piętnaście", "szesnaście", "siednaście", "osiemnście", "dziewiętnaście")

liczba = d3(Val(Mid(s, 1, 1)))
If Val(Mid(s, 2, 1)) = 1 Then
    liczba = Ad(liczba, dx(Val(Mid(s, 3, 1))))
Else
    liczba = Ad(Ad(liczba, d2(Val(Mid(s, 2, 1)))), d1(Val(Mid(s, 3, 1))))
End If
If (w > 0) And (liczba = d1(1)) Then liczba = ""

End Function

Function slowo(w As Integer, s As String) As String
Dim w1, w2, w3, w4, wz, wg
w1 = Array("tysiąc", "tysiące", "tysięcy")
w2 = Array("milion", "miliony", "milionów")
w3 = Array("miliard", "miliardy", "miliardów")
w4 = Array("bilion", "biliony", "bilionów")
wz = Array("złoty", "złote", "złotych")
wg = Array("grosz", "grosze", "groszy")

Dim n, j, k As Integer
j = Val(s)
If j = 1 Then n = 0 Else n = 2
j = Val(Mid(s, Len(s), 1))
k = Val(Mid(s, Len(s) - 1, 1))
If (j > 1) And (j < 5) And (k <> 1) Then n = 1
If w = 0 Then slowo = "" Else
If w = 1 Then slowo = w1(n) Else
If w = 2 Then slowo = w2(n) Else
If w = 3 Then slowo = w3(n) Else
If w = 4 Then slowo = w4(n) Else
If w = 20 Then slowo = wz(n) Else
If w = 21 Then slowo = wg(n)

End Function

Function Slownie(x As Double) As String
Dim p As Long ' get tens xxxx or decimals yy ( xxxx,yy )
Dim s As String ' string representation of xxxx or yy
Dim w As Integer ' triple counter iterator
Dim c As String ' current triple value
Dim m As Boolean
m = x < 0
If m Then x = -x

Slownie = ""
p = Int(x)     ' 123456789012
s = CStr(p)    ' "123456789012" (123-456-789-012)
While Len(s) Mod 3 <> 0: s = "0" + s: Wend ' padding to whole triplets
For w = 0 To 4
    If Len(s) > w * 3 Then
        c = Mid(s, Len(s) - w * 3 - 2, 3) ' i=0 => "012", i=1 => "789"
        If c <> "000" Then
            Slownie = Ad(Ad(liczba(w, c), slowo(w, c)), Slownie)
        End If
    End If
Next w
If Slownie = "" Then Slownie = "zero"
Slownie = Ad(Slownie, slowo(20, s))

p = (x - p) * 100
If p > 0 Then
    s = Trim(Str(p))
    While Len(s) Mod 3 <> 0: s = "0" + s: Wend
    Slownie = Ad(Slownie, Ad(liczba(0, s), slowo(0, s)))
    Slownie = Ad(Slownie, slowo(21, s))
Else
    If zerogroszy Then Slownie = Slownie + " zero groszy"
End If
If m Then Slownie = Ad("minus", Slownie)

End Function

1 użytkowników online, w tym zalogowanych: 0, gości: 1