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

  • Delila_1

    Topikgazda

    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

    Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.

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