Új hozzászólás Aktív témák

• #48502 Delila_1 veterán Nixon18 #48495

  Új Válasz 2022-02-15 20:17:20 #48502

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Nixon18 #48495 üzenetére

  Valamikor régen már feltettem a makrót – talán többször is – de most nem találom. Újra felteszem.

  Function Szam_kiiras(szam As Long) As String
    Dim j1, j10, j10a, j100
    j1 = Array("", "egy", "kettő", "három", "négy", "öt", "hat", "hét", "nyolc", "kilenc")
    j10 = Array("", "tíz", "húsz", "harminc", "negyven", "ötven", "hatvan", "hetven", "nyolcvan", "kilencven")
    j10a = Array("", "tizen", "huszon", "harminc", "negyven", "ötven", "hatvan", "hetven", "nyolcvan", "kilencven")
    j100 = Array("száz", "", "ezer", "millió", "milliárd")
    betu = ""
    If szam = 0 Then
        Szam_kiiras = "Nulla"
        Exit Function
    End If
    s = Format(szam, "0")
    j = 1
    While s <> ""
        i = Len(s) - 2
        If i < 1 Then i = 1
        s2 = Mid(s, i, 3)
        s = Left(s, i - 1)
        s3 = ""
        If Len(s2) = 3 Then
            s3 = s3 + j1(Asc(Mid(s2, 1, 1)) - 48)
            If Mid(s2, 1, 1) <> "0" Then s3 = s3 + j100(0)
            s2 = Right(s2, Len(s2) - 1)
        End If
        If Len(s2) = 2 Then
            If Mid(s2, 2, 1) = "0" Then
                s3 = s3 + j10(Asc(Mid(s2, 1, 1)) - 48)
            Else
                s3 = s3 + j10a(Asc(Mid(s2, 1, 1)) - 48)
            End If
            s2 = Right(s2, Len(s2) - 1)
        End If
        s3 = s3 + j1(Asc(Mid(s2, 1, 1)) - 48)
        If s3 <> "" Then s3 = s3 + j100(j)
        If (betu <> "") And (szam > 2000) And (s3 <> "") Then kot = "-" Else kot = ""
        betu = s3 + kot + betu
        j = j + 1
    Wend
    betu = UCase(Left(betu, 1)) & Right(betu, Len(betu) - 1)
    Szam_kiiras = betu
End Function

Új hozzászólás Aktív témák