Untitled

Sub liczba_1_konwersja()
Dim liczba As Double     ' liczba
Dim x1 As String    ' liczba slowami
Range("B14").Select                         ' Miejsce dla danych
   liczba = ActiveCell.Offset(0, 0)             ' Czytaj Liczbe
      x1 = Liczba_slowa(liczba)
  ActiveCell.Offset(0, 1) = x1 ' zapis liczby slowami
    
End Sub

Sub licz_zakres_konwersja()
Dim x1 As String    ' liczba slowami
Dim liczba As Double     ' liczba
Dim Linia As Variant
Dim Nazwa_Ark_Katalog As String
Dim Nrlinii As Integer
Nazwa_Ark_Katalog = Arkusz1.Name
Worksheets(Nazwa_Ark_Katalog).Activate ' aktywacja arkusza z danymi katalogowymi
     
Range("A4").Select                         ' Zaznaczenie obszaru dla nazwy maszyny
    Selection.CurrentRegion.Select
    Selection.CurrentRegion.Select
    Nrlinii = 0
 For Each Linia In Selection.Rows
    liczba = ActiveCell.Offset(Nrlinii, 0)             ' Czytaj Liczbe
      
x1 = Liczba_slowa(liczba)
  ActiveCell.Offset(Nrlinii, 1) = x1 ' zapis liczby slowami
  Nrlinii = Nrlinii + 1
  Next
MsgBox "Koniec przeliczania zakresu"
Range("A4").Select                         ' Zaznaczenie obszaru dla nazwy maszyny
End Sub

Function Liczba_slowa(wej_liczba As Double) As Variant
'===================================================================
'=   Procedure: Liczba_slowa                                       =
'=        Type: Function                                           =
'=                                                                 =
'=     Opis: zamiana liczby na jej reprezentację słowną          =
'=  Parametr: wej_liczba - Double                                 =

Application.Volatile
'zmienne do przechowywania części składowych argumentu dblAmount,
'tysięcy złotych, złotych i groszy.
Dim intST As Integer, intDT As Integer, intTY As Integer
Dim intSZ As Integer, intDZ As Integer, intZL As Integer
Dim intDG As Integer, intGR As Integer

'zmienne pomocne przy określaniu prawidłowej formy gramatycznej
'słów : tysiąc, złoty, grosz.
Dim intT As Integer, intZ As Integer, intG As Integer

'zmienne te przechowują odpowiedni element tekstowy ze zdefinowanych
'niżej tablic.
Dim varSETKI As Variant, varDZIESIATKI As Variant, varNASTKI As Variant
Dim varJEDNOSTKI As Variant, varTYSIACE As Variant, varZLOTE As Variant
Dim varGROSZE As Variant
Dim strSLOWNIE As String, strAMOUNT As String

'jeżeli wartość absolutna liczby przekracza 999.999,99 funkcja zwraca
'wartość błędu #N/A.

If Abs(wej_liczba) > 999999.99 Then
  Liczba_slowa = CVErr(xlErrNA)
  Exit Function
End If

'zdefiniowanie tablic zawierających wartości słowne odpowiadające
'elementom wartości
varSETKI = Array("", "sto ", "dwieście ", "trzysta ", "czterysta ", _
"pięćset ", "sześćset ", "siedemset ", "osiemset ", "dziewięćset ")

varDZIESIATKI = Array("", "dziesięć ", "dwadzieścia ", "trzydzieści ", _
"czterdzieści ", "pięćdziesiąt ", "sześćdziesiąt ", "siedemdziesiąt ", _
"osiemdziesiąt ", "dziewięćdziesiąt ")

varNASTKI = Array("", "jedenaście ", "dwanaście ", "trzynaście ", _
"czternaście ", "piętnaście ", "szesnaście ", "siedemnaście ", _
"osiemnaście ", "dziewiętnaście ")

varJEDNOSTKI = Array("", "jeden ", "dwa ", "trzy ", "cztery ", _
"pięć ", "sześć ", "siedem ", "osiem ", "dziewięć ")

varTYSIACE = Array("", "tysiąc ", "tysiące ", "tysięcy ")
'****** TUTAJ ZMIANA   TAK BYŁO WCZEŚNIEJ
' varZLOTE = Array("zero, ", ", ", ", ", ", ")
varZLOTE = Array("zero  zł,", "zł, ", "zł, ", "zł, ")
'****** TUTAJ ZMIANA   TAK BYŁO WCZEŚNIEJ
'varGROSZE = Array("zero ", " ", " ", " ")
 varGROSZE = Array("zero groszy", "grosz ", "grosze ", "groszy ")

'zamiana liczby na tekst w formacie '00000000'.
strAMOUNT = Format(Abs(Application.WorksheetFunction.Round(wej_liczba, 2) * 100), "00000000")

'rozbijamy liczbe na części składowe.
'Tysiace
intST = Val(Mid(strAMOUNT, 1, 1))
intDT = Val(Mid(strAMOUNT, 2, 1))
intTY = Val(Mid(strAMOUNT, 3, 1))
'Zlote
intSZ = Val(Mid(strAMOUNT, 4, 1))
intDZ = Val(Mid(strAMOUNT, 5, 1))
intZL = Val(Mid(strAMOUNT, 6, 1))
'Grosze
intDG = Val(Mid(strAMOUNT, 7, 1))
intGR = Val(Mid(strAMOUNT, 8, 1))

strSLOWNIE = varSETKI(intST)

'kod poniżej służy umożliwia zwrócenie prawidłowej formy
'gramatycznej liczebników.
If intDT = 1 And intTY <> 0 Then
  strSLOWNIE = strSLOWNIE & varNASTKI(intTY)
Else
  strSLOWNIE = strSLOWNIE & varDZIESIATKI(intDT) & varJEDNOSTKI(intTY)
End If

'Tysiące
If (intST + intDT + intTY) = 0 Then
  intT = 0
ElseIf (intST + intDT) = 0 And intTY = 1 Then
  intT = 1
ElseIf (intTY = 2 Or intTY = 3 Or intTY = 4) And intDT <> 1 Then
  intT = 2
Else
  intT = 3
End If

strSLOWNIE = strSLOWNIE & varTYSIACE(intT) & varSETKI(intSZ)

'pojedyncze
If intDZ = 1 And intZL <> 0 Then
  strSLOWNIE = strSLOWNIE & varNASTKI(intZL)
Else
  strSLOWNIE = strSLOWNIE & varDZIESIATKI(intDZ) & varJEDNOSTKI(intZL)
End If

If (intST + intDT + intTY + intSZ + intDZ + intZL) = 0 Then
  intZ = 0
ElseIf (intSZ + intDZ = 0) And intZL = 1 Then
  intZ = 1
ElseIf (intZL = 2 Or intZL = 3 Or intZL = 4) And intDZ <> 1 Then
  intZ = 2
Else
  intZ = 3
End If
'****** TUTAJ ZMIANA   TAK BYŁO WCZEŚNIEJ
 strSLOWNIE = strSLOWNIE & varZLOTE(intZ)
'strSLOWNIE = strSLOWNIE & varZLOTE(intZ) & "zł,  "

'0.1 dziesiatki
If intDG = 1 And intGR <> 0 Then
  strSLOWNIE = strSLOWNIE & varNASTKI(intGR)
Else
  strSLOWNIE = strSLOWNIE & varDZIESIATKI(intDG) & varJEDNOSTKI(intGR)
End If

If intDG + intGR = 0 Then
  intG = 0
ElseIf intDG = 0 And intGR = 1 Then
  intG = 1
ElseIf (intGR = 2 Or intGR = 3 Or intGR = 4) And intDG <> 1 Then
  intG = 2
Else
  intG = 3
End If

strSLOWNIE = strSLOWNIE & varGROSZE(intG)
Liczba_slowa = strSLOWNIE

End Function