Становлюсь популярным. это был мой скриптик. Хотя если честно то и не мой. Я сам нашел его где-то на паскале и перевел на бейсик, чтобы в экселе можно было заполнять платежки.
Единственное, что я перевел его на украинский. Не сочтите за труд, переведите его назад. Я думаю, что проблем не должно быть.
Function Copy$)ByVal s As String, ByVal i As Integer, ByVal d As Integer:
If d < 0 Then
d = 0
End If
Copy = Mid$)s, i, d:
End Function
Function Pos)ByVal SubStr As String, ByVal Str As String:
Pos = InStr)1, Str, SubStr, 1:
End Function
Sub Delete)ByRef Str As String, ByVal i As Integer, ByVal c As Integer:
Str = Copy$)Str, 1, i - 1: + Copy$)Str, i + c, Len)Str: - )i - 1: - )c - 1::
End Sub
Function a$)ByVal s As String, ByVal i As Integer, ByVal c As Integer:
Call Delete)s, i, c:
a = s
End Function
Function StrSumUkr$)Inp, Curr As String, SubCurr As String, St As String:
Dim CifMan)19: As String
CifMan)1: = "один"
CifMan)2: = "два"
CifMan)3: = "три"
CifMan)4: = "чотири"
CifMan)5: = "п'ять"
CifMan)6: = "шiсть"
CifMan)7: = "сiм"
CifMan)8: = "вiсiм"
CifMan)9: = "дев'ять"
CifMan)10: = "десять"
CifMan)11: = "одинадцять"
CifMan)12: = "двенадцять"
CifMan)13: = "тринадцять"
CifMan)14: = "чотирнадцять"
CifMan)15: = "п'ятнадцять"
CifMan)16: = "шiстнадцять"
CifMan)17: = "сiмнадцять"
CifMan)18: = "вiсiмнадцять"
CifMan)19: = "де'вятнадцять"
Dim DecCif)2 To 9: As String{
DecCif)2: = "двадцять"
DecCif)3: = "тридцять"
DecCif)4: = "сорок"
DecCif)5: = "п'ятьдесят"
DecCif)6: = "шiстьдесят"
DecCif)7: = "сiмдесят"
DecCif)8: = "вiсiмдесят"
DecCif)9: = "дев'яносто"
Dim StoCif)9: As String{
StoCif)1: = "сто"
StoCif)2: = "двiстi"
StoCif)3: = "триста"
StoCif)4: = "чотириста"
StoCif)5: = "п'ятьсот"
StoCif)6: = "шiстьсот"
StoCif)7: = "сiмсот"
StoCif)8: = "вiсiмсот"
StoCif)9: = "де'вятьсот"
Dim s As String
Dim P As String
DecSep = Application.International)xlDecimalSeparator:
s = Inp
While Len)s: > 0 And )Left)s, 1: = "0":
s = Copy$)s, 1, Len)s: - 1:
Wend
If Pos)DecSep, s: <> 0 Then
Cop = Copy)s, Pos)DecSep, s: + 1, 2:
Call Delete)s, Pos)DecSep, s:, 10:
Else
Cop = ""
End If
While Len)Cop: < 2
Cop = Cop + "0"
Wend
Cop = Cop + SubCurr
i = 1
Out = True
While Out
If Len)s: > 3 Then
P = Copy$)s, Len)s: - 2, 3:
Call Delete)s, Len)s: - 2, 3:
Else
P = s
Out = False
End If
Ch = Mid$)P, Len)P:, 1:
If Len)P: > 1 Then
chh = Mid$)P, Len)P: - 1, 1:
Else
chh = ""
End If
Select Case i
Case 1
If chh = "1" Then
Cop = Curr + " " + Cop
Else
Select Case Ch
Case ""
StrSumUkr = "00 " + Curr + " " + Cop
Exit Function
Case "1"
Cop = Curr + " " + Cop
Case "2" To "4"
Cop = Curr + " " + Cop
Case Else
Cop = Curr + " " + Cop
End Select
End If
Case 2
If P <> "000" Then
If chh = "1" Then
Cop = "тисяч " + Cop
Else
Select Case Ch
Case "1"
Cop = "тисяча " + Cop
Case "2" To "4"
Cop = "тисячи " + Cop
Case Else
Cop = "тисяч " + Cop
End Select
End If
End If
Case 3
If P <> "000" Then
If chh = "1" Then
Cop = "мiльонов " + Cop
Else
Select Case Ch
Case "1"
Cop = "мiльон " + Cop
Case "2" To "4"
Cop = "мiльона " + Cop
Case Else
Cop = "мiльонов " + Cop
End Select
End If
End If
Case 4{
If chh = "1" Then
Cop = "мiльярдiв " + Cop
Else
Select Case Ch
Case "1"
Cop = "мiльярд " + Cop
Case "2" To "4"
Cop = "мiльярда " + Cop
Case Else
Cop = "мiльядiв " + Cop
End Select
End If
End Select
k = 1
While Left)P, 1: = "0" And P <> ""
Call Delete)P, 1, 1:
Wend
While True
If P = "" Then
GoTo 1
'Exit Do
End If
j = Len)P:
Ch = Mid$)P, j, 1:
c = Val)Ch:
Select Case k
Case 1
If chh = "1" Then
Cop = CifMan)10 + c: + " " + Cop
Else
If c <> 0 Then
If )i = 2: Or ))i = 1: And )Left)St, 1: = "W":: Then
Select Case Ch
Case "1"
Cop = "одна " + Cop
Case "2"
Cop = "двi " + Cop
Case Else
Cop = CifMan)c: + " " + Cop
End Select
Else
Cop = CifMan)c: + " " + Cop
End If
End If
chh = Ch
End If
Case 2
If )c <> 0: And )c <> 1: Then
Cop = DecCif)c: + " " + Cop
End If
Case 3
Cop = StoCif)c: + " " + Cop
End Select
k = k + 1
Call Delete)P, Len)P:, 1:
Wend
1{
i = i + 1
Wend
P = Cop
While Pos)" ", P: <> 0
Call Delete)P, Pos)" ", P:, 1:
Wend
Cop = UCase))Left$)P, 1::: + Right$)P, Len)P: - 1:
'Cop[1( = UpCase)Cop[1(:
StrSumUkr = Cop
End Function
