ardour007

Здравствуйте, помогите пожалуйста переделать модуль на VBA, который используется для перевода числа в число прописью. Проблема заключается в том, что нужно в отчете Access подсчитать количество строк, а затем в следующем поле вывести это значение прописью. Раньше выводилась в отчете общая сумма в таком формате "суммапрописью(Module) рублей 00 коп." Вот отчет в Конструкторе отчетов




Вот код старого Module

Option Compare Database 'Использовать функции базы данных при сравнении строк
'Option Explicit ' Требует явного описания переменных перед их использованием.

Global Сумма As Currency, Остаток As Currency

Function Десятки(Разряд As Long) As String

Select Case Разряд
Case 2
Десятки = "двадцать "
Case 3
Десятки = "тридцать "
Case 4
Десятки = "сорок "
Case 5
Десятки = "пятьдесят "
Case 6
Десятки = "шестьдесят "
Case 7
Десятки = "семьдесят "
Case 8
Десятки = "восемьдесят "
Case 9
Десятки = "девяносто "
End Select

End Function

Function Единицы(Разряд As Long, Род As String) As String

Select Case Разряд
Case 1
If Род = "Мужской" Then
Единицы = "один "
Else
Единицы = "одна "
End If
Case 2
If Род = "Мужской" Then
Единицы = "два "
Else
Единицы = "две "
End If
Case 3
Единицы = "три "
Case 4
Единицы = "четыре "
Case 5
Единицы = "пять "
Case 6
Единицы = "шесть "
Case 7
Единицы = "семь "
Case 8
Единицы = "восемь "
Case 9
Единицы = "девять "
Case 10
Единицы = "десять "
Case 11
Единицы = "одиннадцать "
Case 12
Единицы = "двенадцать "
Case 13
Единицы = "тринадцать "
Case 14
Единицы = "четырнадцать "
Case 15
Единицы = "пятнадцать "
Case 16
Единицы = "шестнадцать "
Case 17
Единицы = "семнадцать "
Case 18
Единицы = "восемнадцать "
Case 19
Единицы = "девятнадцать "

End Select

End Function

Function Миллионы(Разряд As Long) As String

If Разряд = 1 Then
Миллионы = "миллион "
ElseIf Разряд > 1 And Разряд < 5 Then
Миллионы = "миллиона "
Else
Миллионы = "миллионов "
End If

End Function

Function Рубли(ДесяткиРублей As Long) As String
Select Case ДесяткиРублей
Case 0, 5 To 20
Рубли = "рублей"
Case Else
Select Case (ДесяткиРублей - Int(ДесяткиРублей / 10) * 10)
Case 0, 5 To 9
Рубли = "рублей"
Case 1
Рубли = "рубль"
Case 2 To 4
Рубли = "рубля"
End Select
End Select
End Function

Function Сотни(Разряд As Long) As String

Select Case Разряд
Case 1
Сотни = "сто "
Case 2
Сотни = "двести "
Case 3
Сотни = "триста "
Case 4
Сотни = "четыреста "
Case 5
Сотни = "пятьсот "
Case 6
Сотни = "шестьсот "
Case 7
Сотни = "семьсот "
Case 8
Сотни = "восемьсот "
Case 9
Сотни = "девятьсот "
End Select

End Function
Function СУММАПРОПИСЬЮ(СуммаСчета As Currency) As String

Dim Группа As Double, Разряд As Long, Длина As Long
Dim Пропись As String, Копейки As Integer, ДесяткиРублей As Long

If IsNull(СуммаСчета) Or IsEmpty(СуммаСчета) Or СуммаСчета = 0 Then
СУММАПРОПИСЬЮ = "Ноль рублей 00 коп."
Exit Function
End If
Сумма = Int(СуммаСчета)
Копейки = СуммаСчета * 100 - Int(СуммаСчета) * 100
ДесяткиРублей = 0

Rem Milions

Группа = СуммаСчета / 1000000
If Группа >= 1 Then
If Группа >= 100 Then
Разряд = Группа / 100
If Разряд > Группа / 100 Then Разряд = Разряд - 1
Пропись = Пропись & Сотни(Разряд)
Группа = Группа - Разряд * 100
End If
If Группа > 19 Then
Разряд = Группа / 10
If Разряд > Группа / 10 Then Разряд = Разряд - 1
Пропись = Пропись & Десятки(Разряд)
Группа = Группа - Разряд * 10
End If

Разряд = Группа
If Разряд > Группа Then Разряд = Разряд - 1
Пропись = Пропись & Единицы(Разряд, "Мужской")

Пропись = Пропись & Миллионы(Разряд)
End If

Rem Тыщи

Группа = СуммаСчета / 1000 - Int(СуммаСчета / 1000000) * 1000
If Группа >= 1 Then
If Группа >= 100 Then
Разряд = Группа / 100
If Разряд > Группа / 100 Then Разряд = Разряд - 1
Пропись = Пропись & Сотни(Разряд)
Группа = Группа - Разряд * 100
End If
If Группа > 19 Then
Разряд = Группа / 10
If Разряд > Группа / 10 Then Разряд = Разряд - 1
Пропись = Пропись & Десятки(Разряд)
Группа = Группа - Разряд * 10
End If

Разряд = Группа
If Разряд > Группа Then Разряд = Разряд - 1
Пропись = Пропись & Единицы(Разряд, "Женский")

Пропись = Пропись & Тысячи(Разряд)
End If

Rem десятки

Группа = СуммаСчета - Int(СуммаСчета / 1000) * 1000
If Группа >= 1 Then
If Группа >= 100 Then
Разряд = Группа / 100
If Разряд > Группа / 100 Then Разряд = Разряд - 1
Пропись = Пропись & Сотни(Разряд)
Группа = Группа - Разряд * 100
End If

If Группа > 19 Then
Разряд = Группа / 10
If Разряд > Группа / 10 Then Разряд = Разряд - 1
ДесяткиРублей = Остаток
Пропись = Пропись & Десятки(Разряд)
Группа = Группа - Разряд * 10
End If

Разряд = Группа
If Разряд > Группа Then Разряд = Разряд - 1
Пропись = Пропись & Единицы(Разряд, "Мужской")
End If

Длина = Len(Пропись)

Пропись = Пропись & Рубли(ДесяткиРублей)
Длина = Len(Пропись)
Пропись = UCase(Mid(Пропись, 1, 1)) & (Mid(Пропись, 2, Длина))

СУММАПРОПИСЬЮ = Пропись & IIf(Копейки < 10, " 0", " ") & Копейки & " коп."

End Function

Function Тысячи(Разряд As Long) As String

If Разряд = 1 Then
Тысячи = "тысяча "
ElseIf Разряд > 1 And Разряд < 5 Then
Тысячи = "тысячи "
Else
Тысячи = "тысяч "
End If

End Function




А теперь нужно "рублей 00 коп." убрать из кода и соответственно из отчета, чтобы выводилать не сумма в рублях, а только количество строк (записай) из таблицы прописью. Попытки найти готовый код в интернете привели в такому коду.

Option Compare Database

Function SUMMPROP(n As Double) As String

Dim Nums1, Nums2, Nums3, Nums4 As Variant

Nums1 = Array("", "один ", "два ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ")
Nums2 = Array("", "десять ", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", "семьдесят ", _
"восемьдесят ", "девяносто ")
Nums3 = Array("", "сто ", "двести ", "триста ", "четыреста ", "пятьсот ", "шестьсот ", "семьсот ", _
"восемьсот ", "девятьсот ")
Nums4 = Array("", "одна ", "две ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ")
Nums5 = Array("десять ", "одиннадцать ", "двенадцать ", "тринадцать ", "четырнадцать ", _
"пятнадцать ", "шестнадцать ", "семнадцать ", "восемнадцать ", "девятнадцать ")

If n <= 0 Then
PropisRus = "ноль"
Exit Function
End If
'разделяем число на разряды, используя вспомогательную функцию Class
ed = Class(n, 1)
dec = Class(n, 2)
sot = Class(n, 3)
tys = Class(n, 4)
dectys = Class(n, 5)
sottys = Class(n, 6)
mil = Class(n, 7)
decmil = Class(n, 8)

'проверяем миллионы
Select Case decmil
Case 1
mil_txt = Nums5(mil) & "миллионов "
GoTo www
Case 2 To 9
decmil_txt = Nums2(decmil)
End Select
Select Case mil
Case 1
mil_txt = Nums1(mil) & "миллион "
Case 2, 3, 4
mil_txt = Nums1(mil) & "миллиона "
Case 5 To 20
mil_txt = Nums1(mil) & "миллионов "
End Select
www:
sottys_txt = Nums3(sottys)
'проверяем тысячи
Select Case dectys
Case 1
tys_txt = Nums5(tys) & "тысяч "
GoTo eee
Case 2 To 9
dectys_txt = Nums2(dectys)
End Select
Select Case tys
Case 0
If dectys > 0 Then tys_txt = Nums4(tys) & "тысяч "
Case 1
tys_txt = Nums4(tys) & "тысячa "
Case 2, 3, 4
tys_txt = Nums4(tys) & "тысячи "
Case 5 To 9
tys_txt = Nums4(tys) & "тысяч "
End Select
If dectys = 0 And tys = 0 And sottys <> 0 Then sottys_txt = sottys_txt & " тысяч "
eee:
sot_txt = Nums3(sot)
'проверяем десятки
Select Case dec
Case 1
ed_txt = Nums5(ed)
GoTo rrr
Case 2 To 9
dec_txt = Nums2(dec)
End Select

ed_txt = Nums1(ed)
rrr:
'формируем итоговую строку
SUMMPROP = decmil_txt & mil_txt & sottys_txt & dectys_txt & tys_txt & sot_txt & dec_txt & ed_txt
End Function

'вспомогательная функция для выделения из числа разрядов
Private Function Class(M, I)
Class = Int(Int(M - (10 ^ I) * Int(M / (10 ^ I))) / 10 ^ (I - 1))
End Function

Пытаюсь сделать все по аналогии, создал резервную копию БД, из старого отчета все перенес в новое, незначительно изменив форму, изменил код модуля на новый. После чего пытаюсь вставить его в форму





Проверял его в качестве Module на Excel, всё отлично работает, указываешь адрес числовой ячейки, например E1, в текущей ячейке вставляешь функцию SUMMPROP из модуля с указанием на ячеёку E1 и вуаля, все цифры отображаются прописью. НО!

В Access при предварительном просмотре отчета выходит окно и требует ввести значение параметра для данного модуля SUMMPROP...В общем все изложил в скринах.




Результат



Уважаемые программисты, для кого это плёвое дело, дайте решение сей проблемы...