Jeg har denne makro som kommer fra Excel.
Code: Select all
Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Option Explicit
Function SLOWNIE(Kwota As Double) As Variant
'xxx xxx,xx - 123 456,78
Dim CzesciLiczby(1 To 8) As Integer
Dim GROSZE As Variant
Dim JEDNOSTKI As Variant
Dim NASCIE As Variant
Dim DZIESIATKI As Variant
Dim SETKI As Variant
Dim TYSIACE As Variant
Dim ZLOTE As Variant
Dim KwotaSlownie As String
Dim LiczbyKolejno As String
Dim GramTysiace As Integer
Dim GramSetki As Integer
Dim GramGrosze As Integer
If Abs(Kwota) > 999999.99 Then
SLOWNIE = CVErr(xlErrNA)
Exit Function
End If
SETKI = Array("", "sto ", "dwieście ", "trzysta ", "czterysta ", _
"pięćset ", "sześćset ", "siedemset ", "osiemset ", "dziewięćset ")
DZIESIATKI = Array("", "dziesięć ", "dwadzieścia ", "trzydzieści ", _
"czterdzieści ", "pięćdziesiąt ", "sześćdziesiąt ", "siedemdziesiąt ", _
"osiemdziesiąt ", "dziewięćdziesiąt ")
NASCIE = Array("", "jedenaście ", "dwanaście ", "trzynaście ", _
"czternaście ", "piętnaście ", "szesnaście ", "siedemnaście ", _
"osiemnaście ", "dziewiętnaście ")
JEDNOSTKI = Array("", "jeden ", "dwa ", "trzy ", "cztery ", _
"pięć ", "sześć ", "siedem ", "osiem ", "dziewięć ")
TYSIACE = Array("", "tysiąc ", "tysiące ", "tysięcy ")
ZLOTE = Array("zero złotych ", "złoty ", "złote ", "złotych ")
GROSZE = Array("zero groszy ", "grosz ", "grosze ", "groszy ")
LiczbyKolejno = Format(Abs(Round(Kwota, 2) * 100), "00000000")
'xxx xxx,xx - 123 456,78
CzesciLiczby(1) = Val(Mid(LiczbyKolejno, 1, 1))
CzesciLiczby(2) = Val(Mid(LiczbyKolejno, 2, 1))
CzesciLiczby(3) = Val(Mid(LiczbyKolejno, 3, 1))
CzesciLiczby(4) = Val(Mid(LiczbyKolejno, 4, 1))
CzesciLiczby(5) = Val(Mid(LiczbyKolejno, 5, 1))
CzesciLiczby(6) = Val(Mid(LiczbyKolejno, 6, 1))
CzesciLiczby(7) = Val(Mid(LiczbyKolejno, 7, 1))
CzesciLiczby(8) = Val(Mid(LiczbyKolejno, 8, 1))
KwotaSlownie = SETKI(CzesciLiczby(1))
If CzesciLiczby(2) = 1 And CzesciLiczby(3) <> 0 Then
KwotaSlownie = KwotaSlownie & NASCIE(CzesciLiczby(3))
Else
KwotaSlownie = KwotaSlownie & DZIESIATKI(CzesciLiczby(2)) & JEDNOSTKI(CzesciLiczby(3))
End If
'Tysiące
If (CzesciLiczby(1) + CzesciLiczby(2) + CzesciLiczby(3)) = 0 Then
GramTysiace = 0
ElseIf (CzesciLiczby(1) + CzesciLiczby(2)) = 0 And CzesciLiczby(3) = 1 Then
GramTysiace = 1
ElseIf (CzesciLiczby(3) = 2 Or CzesciLiczby(3) = 3 Or CzesciLiczby(3) = 4) And CzesciLiczby(2) <> 1 Then
GramTysiace = 2
Else
GramTysiace = 3
End If
KwotaSlownie = KwotaSlownie & TYSIACE(GramTysiace) & SETKI(CzesciLiczby(4))
If CzesciLiczby(5) = 1 And CzesciLiczby(6) <> 0 Then
KwotaSlownie = KwotaSlownie & NASCIE(CzesciLiczby(6))
Else
KwotaSlownie = KwotaSlownie & DZIESIATKI(CzesciLiczby(5)) & JEDNOSTKI(CzesciLiczby(6))
End If
If (CzesciLiczby(1) + CzesciLiczby(2) + CzesciLiczby(3) + CzesciLiczby(4) + CzesciLiczby(5) + CzesciLiczby(6)) = 0 Then
GramSetki = 0
ElseIf (CzesciLiczby(4) + CzesciLiczby(5) = 0) And CzesciLiczby(6) = 1 Then
GramSetki = 1
ElseIf (CzesciLiczby(6) = 2 Or CzesciLiczby(6) = 3 Or CzesciLiczby(6) = 4) And CzesciLiczby(5) <> 1 Then
GramSetki = 2
Else
GramSetki = 3
End If
KwotaSlownie = KwotaSlownie & ZLOTE(GramSetki) & "i "
If CzesciLiczby(7) = 1 And CzesciLiczby(8) <> 0 Then
KwotaSlownie = KwotaSlownie & NASCIE(CzesciLiczby(8))
Else
KwotaSlownie = KwotaSlownie & DZIESIATKI(CzesciLiczby(7)) & JEDNOSTKI(CzesciLiczby(8))
End If
If CzesciLiczby(7) + CzesciLiczby(8) = 0 Then
GramGrosze = 0
ElseIf CzesciLiczby(7) = 0 And CzesciLiczby(8) = 1 Then
GramGrosze = 1
ElseIf (CzesciLiczby(8) = 2 Or CzesciLiczby(8) = 3 Or CzesciLiczby(8) = 4) And CzesciLiczby(7) <> 1 Then
GramGrosze = 2
Else
GramGrosze = 3
End If
KwotaSlownie = KwotaSlownie & GROSZE(GramGrosze)
SLOWNIE = KwotaSlownie
End Function1. Ved indlæsning af gemt regneark som xls virker det.
2. Ved indlæsning af gemt regneark som ods virker det ikke. Den melder fejl med #Name?. Det samme gælder for en skabelon.
Ved at udkommentere 'LiczbyKolejno = Format(Abs(Round(Kwota, 2) * 100), "00000000")' og rette i formlen vil den rapportere 0. Derefter fjernes udkommenteringen og makro virker efter hensigten. Regnearket gemmes igen. Næste gang regnearket indlæses er fejlen opstået igen.
Anvender 3.4.4.
Der er mulighed for at fremsende en fil, hvis det vil hjælpe på fejlsøgningen.
Lad jer ikke forvirre af at teksten er på polsk.