Приложение 1. Модуль Общие

В этом приложении приводятся комментированные тексты из модуля Общие. Этот модуль находится в файле Tables_2003.mdb, который можно скачать с http://msi77.narod.ru/Tables_2003.zip. Напомним, что процедуры и функции, помещенные в модули базы данных, могут вызываться из любых процедур модуля, а также событийных процедур форм и отчетов. Кроме того, функции могут использоваться в макросах, запросах, а также в качестве источника данных для различных элементов управления.

‘Раздел описаний
Option Compare Database ‘обеспечивает регистронезависимое сравнение
Option Explicit ‘описание переменных является обязательным
Public crit As String

‘Эта функция возвращает число прописью как денежную сумму.
‘При этом копейки записываются числом
‘Используется пользовательская функция Func_StrNum
Function Rub_kop(dnu As Double) As String
Dim rub, kop As Long
Dim dnum As Double

dnum = dnu + 0.005 ‘Округление до копейки
rub = Fix(dnum) ‘Рубли
kop = Fix((dnum - rub) * 100) ‘Копейки
Rub_kop = Func_StrNum(dnum, 0) & " руб. " & kop & " коп."
End Function

‘Функция возвращает фамилию и инициалы, преобразуя аргумент,
‘ значениями которого являются
‘строки с фамилией, именем и отчеством, записанными в одном поле
Function ShortName(Str As String)
Dim strW, strF, strN, strSN As String, i, j As Byte
strW = Str
i = InStr(strW, " ")
If i = 0 Then
‘Если аргумент не содержит пробелов, то функция
‘ возвращает сам аргумент
ShortName = strW
Exit Function
End If
j = Len(strW) ‘Количество символов в аргументе
strF = Mid$(strW, 1, i) ‘Фамилия
strN = Mid$(strW, i + 1, 1) ‘Первый символ имени
strW = Mid$(strW, i + 1, j) ‘Оставшиеся символы
i = InStr(strW, " ")
strSN = Mid$(strW, i + 1, 1) ‘Первый символ отчества
ShortName = strF & " " & strN & ". " & strSN & "."
End Function

'Функция записывает числовой аргумент прописью; заимствована из
‘ учебной базы Борей, поставляемой вместе с MS Access 7.0
Function Func_StrNum(dnum As Double, iRod As Integer)
Dim strRes As String
Dim i As Integer
If dnum < 0 Then
Func_StrNum = ""
Exit Function
End If
dnum = Fix(dnum)
If dnum = 0 Then
Func_StrNum = "Ноль"
Exit Function
End If
strRes = ""
i = CInt(Fix(dnum) - Fix((Fix(dnum) / 1000)) * 1000)
If i <> 0 Then
strRes = Func_0_999(i, iRod)
End If
dnum = Fix(dnum / 1000)
If dnum <> 0 Then
i = CInt(Fix(dnum) - Fix((Fix(dnum) / 1000)) * 1000)
If i <> 0 Then
If strRes <> "" Then
strRes = " " & strRes
End If
strRes = Func_0_999(i, 1) & Func_0_999_Def(i, 2) & strRes
End If
Else
GoTo lbUpFirst
End If
dnum = Fix(dnum / 1000)
If dnum <> 0 Then
i = CInt(Fix(dnum) - Fix((Fix(dnum) / 1000)) * 1000)
If i <> 0 Then
If strRes <> "" Then
strRes = " " & strRes
End If
strRes = Func_0_999(i, 0) & Func_0_999_Def(i, 3) & strRes
End If
Else
GoTo lbUpFirst
End If
dnum = Fix(dnum / 1000)
If dnum <> 0 Then
i = CInt(Fix(dnum) - Fix((Fix(dnum) / 1000)) * 1000)
If i <> 0 Then
If strRes <> "" Then
strRes = " " & strRes
End If
strRes = Func_0_999(i, 0) & Func_0_999_Def(i, 4) & strRes
End If
Else
GoTo lbUpFirst
End If
lbUpFirst:
Func_StrNum = UCase(Left(strRes, 1)) & Right(strRes, Len(strRes) - 1)
End Function

'Выбор варианта определяющего слова;
'используется в функции Func_StrNum
Function Func_0_999_Def(ByVal inum As Integer, iDef As Integer)
'iDef = 0 - копейка
'iDef = 1 - рубль
'iDef = 2 - тысяча
'iDef = 3 - миллион
'iDef = 4 - миллиард
'iDef = 5 - день
Dim DefVars As Variant
Dim ivar As Integer
DefVars = Array("копейка", "копейки", "копеек", _
"рубль", "рубля", "рублей", _
"тысяча", "тысячи", "тысяч", _
"миллион", "миллиона", "миллионов", _
"миллиард", "миллиарда", "миллиардов", _
"день", "дня", "дней")
inum = inum Mod 100
iDef = iDef Mod 6
Select Case True
Case inum >= 5 And inum <= 20
ivar = 2
Case (inum Mod 10) = 1
ivar = 0
Case (inum Mod 10) >= 2 And (inum Mod 10) <= 4
ivar = 1
Case Else
ivar = 2
End Select
Func_0_999_Def = " " & DefVars(iDef * 3 + ivar)
End Function

'Число из диапазона 0-999 прописью; используется в функции
‘ Func_0_999_Def
Function Func_0_999(inum As Integer, iRod As Integer)
'iRod = 0 - мужской род
'iRod = 1 - женский род (именительный падеж)
'iRod = 2 - женский род (винительный падеж)
Dim WordsNum As Variant
Dim prp As String, i, j As Integer
WordsNum = Array("один ", "два ", "три ", "четыре ", "пять ", _
"шесть ", "семь ", "восемь ", "девять ", "десять ", _
"одиннадцать ", "двенадцать ", "тринадцать ", "четырнадцать ", _
"пятнадцать ", "шестнадцать ", "семнадцать ", "восемнадцать ", _
"девятнадцать ", "двадцать ", "тридцать ", "сорок ", _
"пятьдесят ", "шестьдесят ", "семьдесят ", "восемьдесят ", _
"девяносто ", "сто ", "двести ", "триста ", "четыреста ", _
"пятьсот ", "шестьсот ", "семьсот ", "восемьсот ", "девятьсот ")
If iRod = 1 Then
WordsNum(0) = "одна "
WordsNum(1) = "две "
Else
If iRod = 2 Then
WordsNum(0) = "однy "
WordsNum(1) = "две "
End If
End If
prp = ""
i = inum \ 100
If i <> 0 Then
prp = WordsNum(i + 26)
End If
i = inum - i * 100
If i <> 0 Then
If i <= 20 Then
prp = prp & WordsNum(i - 1)
Else
j = i \ 10
prp = prp & WordsNum(j + 17)
j = i - j * 10
If j <> 0 Then
prp = prp & WordsNum(j - 1)
End If
End If
End If
If prp <> "" Then
prp = Left(prp, Len(prp) - 1) 'убрать конечный пробел
End If
Func_0_999 = prp
End Function

Добавлять и редактировать данные на форме или в таблицах неудобно, если нужно произвести однотипное изменение для большого количества записей. Подобная операция обычно выполняется либо с помощью запросов на обновление или добавление, либо средствами VBA. Функция Sp_Voz добавляет в таблицу Продажи ряд записей о списании или возврате товаров (смотри главу 9). Одновременно с этим печатается соответствующая накладная.

Function Sp_Voz(Списан As Boolean)
‘Аргумент имеет значение True в случае списания и False при возврате
On Error GoTo Err_
Dim stDocName As String, rst As Recordset, rstS As Recordset
Dim response, crit As String, wrd As String, wrdw As String

If Списан Then
crit = "Сп"
wrdw = "списание"
wrd = "списывать"
Else
crit = "Вт"
wrdw = "возврат"
wrd = "возвращать"

‘Имя отчета, представляющего накладную на списание/возврат
stDocName = "Возвратная накладная"
End If

‘Динамический набор записей из таблицы “Продажи”
Set rstS = CurrentDb.OpenRecordset("Продажи")

‘Динамический набор записей о товарах, подлежащих списанию или
‘возврату в зависимости от значения переменной crit (т.е. либо "Сп",
‘либо "Вт")
Set rst = CurrentDb.OpenRecordset("select * from [Списание/Возврат] _
where Списание = '" & crit & "'")
If Not (rst.RecordCount > 0) Then ‘Нет записей, отвечающих
‘ критерию на списание или возврат
MsgBox "Нечего " & wrd
Exit Function ‘завершаем выполнение функции
End If

stDocName = "Возвратная накладная"

‘ Открываем отчет в режиме просмотра, отбирая записи в
‘соответствии со значением переменной crit
DoCmd.OpenReport stDocName, acPreview, , "Списание = '" & crit & "'"

‘Требуется подтверждение операции, поскольку остаток непроданного
‘ товара будет записан в таблицу Товары как списанный или
‘возвращенный. Если требуется лишь ознакомиться с отчетом,
‘следует ответить “Нет”. В противном случае будут добавлены
‘ записи списании/возврате, и сведения об этих товарах больше
‘ не будут выводиться в форме.
response = MsgBox("Оформляем " & wrdw & "?", _
vbDefaultButton1 + vbYesNo, "Запись в таблицы")
If response = vbNo Then Exit Function

‘Добавление записей в таблицу Продажи о списанных и возвращенных ‘товарах
Do Until rst.EOF ‘ в цикле для каждой записи из набора rst
‘(EOF – индикатор конца набора)
rstS.AddNew ‘добавляем запись в таблицу Продажи,
‘занося в нижеприведенные поля нужные значения
rstS!Товар = rst!Код_товара
rstS!Прод_возвр = crit
rstS!Количество = rst!Остаток
rstS!Дата_продажи = Date ‘текущая дата
rstS.Update ‘ сохранение записи
rst.MoveNext ‘ переход к следующей записи в наборе rst
Loop

‘Обновление формы Списание/возврат
Forms("Списание/возврат").Requery
‘Выход из функции
Exit_:
Exit Function

‘В случае ошибки выдается сообщение на экран, после чего
‘ выполнение функции завершается
Err_:
MsgBox Err.Description
Resume Exit_

End Function