Number2Text makro

Brugerhjælp og support til makroer i LibreOffice Basic

Redaktører: Lodahl, LarsBrandi

Besvar
PKO
Indlæg: 253
Tilmeldt: 17. mar 2009 14:24

Number2Text makro

Indlæg af PKO » 16. nov 2011 18:08

Hej Alle,

Jeg har denne makro som kommer fra Excel.

Kode: Vælg alt

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 Function
Mit problem er at den ikke virker optimalt under LibreOffice.

1. 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.

PKO
Indlæg: 253
Tilmeldt: 17. mar 2009 14:24

Indlæg af PKO » 16. nov 2011 18:54

Jeg fandt en genial udvidelse kaldet NumberText til at løse denne opgave.

http://extensions.services.openoffice.o ... numbertext

Besvar

Hvem er online

Brugere der viser dette forum: Ingen og 1 gæst