Re: Странен въпрос... / Компютри и Интернет / Електронни таблици

Нищо странно :) Опитай да си нагласиш този код според потребностите. Копирано е от други мнения.

За изписване на цифри и числа с думи.
Копира се следното във VBE (Alt+F11)
след което долното се появява като формула "slov"
*********************************
Function Spell(NumStr, i)
Static Units(20) As String, Decim(9) As String, Hundr(11) As String, Thous(5) As String, Thous1(5) As String
Static Units1(20) As String
Units(0) = ""
Units(1) = "един "
Units(2) = "два "
Units(3) = "три "
Units(4) = "четири "
Units(5) = "пет "
Units(6) = "шест "
Units(7) = "седем "
Units(8) = "осем "
Units(9) = "девет "
Units(10) = "десет "
Units(11) = "единадесет "
Units(12) = "дванадесет "
Units(13) = "тринадесет "
Units(14) = "четиринадесет "
Units(15) = "петнадесет "
Units(16) = "шестнадесет "
Units(17) = "седемнадесет "
Units(18) = "осемнадесет "
Units(19) = "деветнадесет "

Units1(0) = ""
Units1(1) = "една "
Units1(2) = "две "
Units1(3) = "три "
Units1(4) = "четири "
Units1(5) = "пет "
Units1(6) = "шест "
Units1(7) = "седем "
Units1(8) = "осем "
Units1(9) = "девет "
Units1(10) = "десет "
Units1(11) = "единадесет "
Units1(12) = "дванадесет "
Units1(13) = "тринадесет "
Units1(14) = "четиринадесет "
Units1(15) = "петнадесет "
Units1(16) = "шестнадесет "
Units1(17) = "седемнадесет "
Units1(18) = "осемнадесет "
Units1(19) = "деветнадесет "

Decim(0) = ""
Decim(1) = "двадесет "
Decim(2) = "тридесет "
Decim(3) = "четиридесет "
Decim(4) = "петдесет "
Decim(5) = "шестдесет "
Decim(6) = "седемдесет "
Decim(7) = "осемдесет "
Decim(8) = "деведесет "

Hundr(0) = ""
Hundr(1) = ""
Hundr(2) = "сто "
Hundr(3) = "двеста "
Hundr(4) = "триста "
Hundr(5) = "четиристотин "
Hundr(6) = "петстотин "
Hundr(7) = "шестстотин "
Hundr(8) = "седемстотин "
Hundr(9) = "осмстотин "
Hundr(10) = "деветстотин "

Thous(0) = ""
Thous(1) = ""
Thous(2) = "хиляди "
Thous(3) = "милиона "
Thous(4) = "милиарда "

Thous1(0) = ""
Thous1(1) = ""
Thous1(2) = "хиляда "
Thous1(3) = "милион "
Thous1(4) = "милиард "
Dim Num, RetStr
RetStr = ""
Num = CInt(NumStr)
If Num = 0 Then
Spell = RetStr
Exit Function
End If

If Num = 1 Then
Select Case i
Case 1
RetStr = "и " & Units(1) & Thous1(1)
Case 2
RetStr = Thous1(2)
Case Else
RetStr = Units(1) & Thous1(i)
End Select
Spell = RetStr
Exit Function
End If

RetStr = RetStr & "и " & Hundr(CInt(Left(NumStr, 1)) + 1)
If CInt(Right(NumStr, 2)) = 0 Then
Spell = RetStr & Thous(i)
Exit Function
End If

If Mid(NumStr, 2, 1) = "0" Or Mid(NumStr, 2, 1) = "1" Then

If i = 2 Then
Spell = RetStr & "и " & Units1(CInt(Mid(NumStr, 2, 2))) & Thous(i)
Else
Spell = RetStr & "и " & Units(CInt(Mid(NumStr, 2, 2))) & Thous(i)
End If
Exit Function
End If

If Right(NumStr, 1) = "0" Then
RetStr = RetStr & Decim(CInt(Mid(NumStr, 2, 1)) - 1)
Else
If i = 2 Then
RetStr = RetStr & Decim(CInt(Mid(NumStr, 2, 1)) - 1) & "и " & Units1(CInt(Right(NumStr, 1)))
Else
RetStr = RetStr & Decim(CInt(Mid(NumStr, 2, 1)) - 1) & "и " & Units(CInt(Right(NumStr, 1)))
End If
End If

Spell = RetStr & Thous(i)

End Function

Function Slov(ByVal Num As Currency)
Static c(5)
Dim NumStr, NumStr1, i, k
If Not IsNull(Num) Then
NumStr = Trim(CStr(Num))
If Num = 0 Then
Slov = "нула"
Exit Function
End If

Dim Buf As String:
If (Num < 0@) Then Buf = "минус " Else Buf = ""
Dim Frac As Currency: Frac = Abs(Num - Fix(Num))
If (Num < 0@ Or Frac <> 0@) Then Num = Abs(Fix(Num))
Dim AtLeastOne As Integer: AtLeastOne = Num >= 1

i = 1
NumStr = Num
Do
If Len(NumStr) > 3 Then
c(i) = Right$(NumStr, 3)
NumStr = Left$(NumStr, Len(NumStr) - 3)
i = i + 1
Else
c(i) = String(3 - Len(NumStr), "0") & NumStr
Exit Do
End If
Loop
NumStr = ""
For k = i To 1 Step -1
NumStr = NumStr & Spell(c(k), k)
Next k
Debug.Print NumStr
If Left(NumStr, 2) = "и " Then
NumStr = Right$(NumStr, Len(NumStr) - 2)
End If
If Left(NumStr, 2) = "и " Then
NumStr = Right$(NumStr, Len(NumStr) - 2)
End If
'стотинки
If (Frac = 0@) Then
Buf = Buf
ElseIf (Int(Frac * 100@) = Frac * 100@) Then
If AtLeastOne Then Buf = Buf & "и "
Buf = Buf & Format$(Frac * 100@, "00")
Else
If AtLeastOne Then Buf = Buf & "и "
Buf = Buf & Format$(Frac * 10000@, "0000")
End If
Slov = NumStr & Buf ' "лв. "
End If
End Function