Автоматизированный учет радиоточек передающего центра

в новом варианте

1. Средняя трудоемкость работ в расчете на 100 КБ

Т_с¹

Т_с²

человеко-час на 100 КБ

2,04

1,96

По данным пользователя

2.Средний расход машинного времени в расчете на 100 КБ

Н_мв¹

Н_мв²

машино-час на 100 КБ

4

3,6

По данным пользователя

3.Средний расход материалов в расчете на 100 КБ

С_м¹

С_м²

руб. на 100 КБ

180

152

По данным пользователя

Объем работ в зависимости от функциональной группы и назначения ПС определяется по формуле:

А = Vо' • Кпс, (6.20)

где Vо' - скорректированный объем ПС, условных машино-команд;

Кпс - коэффициент применения ПС, ед.

Примем значение коэффициента применения Кпс для программного средства равным 0,6.

А =1 656 * 0,6= 993,6 условных машино-команд

Общие капитальные вложения заказчика (потребителя), связанные с приобретением, внедрением и использованием ПС, рассчитываются по формуле:

Ко = Кпр + Кос + Коб, (6.21)

где Кпр - затраты пользователя на приобретение ПС по отпускной цене разработчика с учетом стоимости услуг по эксплуатации и сопровождению, руб.;

Кос - затраты пользователя на освоение ПС, руб.;

Коб - затраты на пополнение оборотных средств в связи с использованием нового ПС, руб.

Кпр примем равным прогнозируемой отпускной цене (618 312 руб.), так как услуги по эксплуатации и сопровождению данного программного средства не требуются.

Затраты на освоение ПС и на пополнение оборотных средств рассчитываются по формулам:

Кос = Кпр * Нкос, (6.22)

Коб = Кпр * Нкоб, (6.23)

где Нкос - норматив расходов на освоение ПС, равен 1%,

Нкоб - норматив расходов на пополнение оборотных средств в связи с использованием нового ПС, равен 2%.

Кос = 618 312 * 0,01 = 6 183 руб,

Коб= 618 312 * 0,02 = 12 366 руб.

Затраты на доукомплектацию Ктс определяются на основе расчета расходов на доукомплектацию конкретными видами технических средств, в случае если это необходимо. Для эксплуатации программного средства не требуется никаких технических средств, кроме персонального компьютера, поэтому примем эти затраты равными 0, так как подразумевается, что рабочее место пользователя, занимающегося программированием на платформе «1С: Предприятие» уже оснащено данным техническим средством.

Таким образом, теперь мы можем рассчитать общие капитальные вложения заказчика (потребителя), связанные с приобретением, внедрением и использованием ПС:

Ко = 618 312 + 6 183 + 12 366 = 636 861 руб.

Экономия затрат на заработную плату при использовании нового ПС в расчете на объем выполненных работ:

Эоз = Эоз' • А, (6.24)

где Эоз - экономия затрат на заработную плату при решении задач с использованием нового ПС, руб.;

Эоз ' - экономия затрат на заработную плату при решении задач с использованием нового ПС в расчете на 100 КБ, руб.;

А - объем выполненных работ с использованием нового ПС, 100 КБ.

Экономия затрат на заработную плату в расчете на 100 КБ:

, (6.25)

где Сзм - среднемесячная заработная плата одного программиста, руб.;

Тс1, Тс2 - трудоемкость работ в расчете на 100 строк кода при базовом и новом варианте соответственно, человеко-часов;

ФРВ - фонд рабочего времени за месяц (169,3), дн.

руб.

Теперь можем рассчитать экономию затрат на заработную плату при использовании нового ПС в расчете на объем выполненных работ:

Эоз =103*993,6= 102 340 руб.

При определении трудоемкости, связанной с использованием программы рекомендуется ориентироваться на показатель равный 30-50% от трудоемкости разработки в часах. Таким образом:

1.96 человеко-час на 100 КБ

Экономия начислений на заработную плату при использовании нового ПС в расчете на объем выполненных работ:

Энач = Эоз • Кнач, (6.26)

где Энач - экономия начислений на заработную плату при решении задач с использованием нового ПС, руб.;

Кнач - коэффициент начислений на заработную плату, ед.

(6.27)

Таким образом экономия начислений на заработную плату при использовании нового ПС в расчете на объем выполненных работ равна:

Энач = Эоз • Кнач (6.28)

Энач = 102 340 * 0,35= 35 819 руб.

Экономия затрат на оплату машинного времени в расчете на выполненный объем работ в результате применения нового ПС:

, (6.29)

где Эмв - экономия затрат на оплату машинного времени при решении задач с использованием нового ПС, руб.;

Эмв' - экономия затрат на оплату машинного времени при решении задач с использованием нового ПС в расчете на 100 КБ, руб.

Экономия затрат на оплату машинного времени в расчете на 100 КБ:

(6.30)

где Смв1, Смв2 - средний расход машинного времени в расчете на 100 КБ при применении базового и нового варианта ПС соответственно, машино-часов.

руб.

Рассчитаем экономию затрат на оплату машинного времени в расчете на выполненный объем работ в результате применения нового ПС:

руб.

Экономия затрат на материалы при использовании нового ПС в расчете на объем выполненных работ:

, (6.31)

где Эм - экономия затрат на материалы при использовании нового ПС, руб.;

Эм ' - экономия затрат на материалы в расчете на 100 КБ при использовании нового ПС, руб.

, (6.32)

где См1, См2 - средний расход материалов у пользователя в расчете на 100 КБ при использовании базового и нового варианта ПС соответственно, руб.

руб.

Таким образом экономия затрат на материалы при использовании нового ПС в расчете на объем выполненных работ равна:

руб.

Общая годовая экономия текущих затрат, связанных с использованием нового ПС:

руб. (6.33)

Внедрение нового ПС позволит пользователю сэкономить на текущих затратах, т.е. практически получить на эту сумму дополнительную прибыль. Для пользователя в качестве экономического эффекта выступает лишь чистая прибыль - дополнительная прибыль, остающаяся в его распоряжении:

, (6.34)

где ? П - прирост прибыли, руб.;

Нп - ставка налога на прибыль, %.

руб.

Рассчитаем прирост чистой прибыли:

(6.35)

где ? Пч - прирост чистой прибыли, руб.;

Нмс - ставка местных налогов и сборов, %.

руб.

В процессе использования нового ПС чистая прибыль в конечном итоге возмещает капитальные затраты. Однако, полученные при этом суммы результатов (прибыли) и затрат (капитальных вложений) по годам приводят к единому времени - расчетному году (за расчетный год принят год разработки ДП) путем умножения результатов и затрат за каждый год на коэффициент привидения (ALFAt), который рассчитывается по формуле:

, (6.36)

где Ен - норматив привидения разновременных затрат и результатов;

tp - расчетный год, tp = 1;

t - номер года, результаты и затраты которого приводятся к расчетному.

2008: ,

2009: ,

2010:

2011: ;

? Пч • ALFA1 = 746 862 руб.,

? Пч • ALFA2 = 746 862 *0,9 = 672 175 руб.,

? Пч • ALFA3 = 746 862 *0,81 = 604 958 руб.,

? Пч• ALFA4 = 746 862 *0,73 = 545 209 руб.;

Ко¹ • ALFA1 = 636 861*1 = 636 861руб.,

Ко² • ALFA2 = 0*0,9=0 руб.,

Ко ³• ALFA3 = 0*0,81=0 руб.,

Ко⁴ • ALFA4 = 0*0,73=0 руб.;

? Пч • ALFA1 - Ко • ALFA1= 746 862 - 636 861= 110 001 руб.,

? Пч • ALFA2 - Ко • ALFA2=672 175 - 0 = 672 175 руб.,

? Пч • ALFA3 - Ко • ALFA3=604 958 - 0 = 604 958 руб.,

? Пч • ALFA3 - Ко • ALFA3 = 545 209 - 0 = 545 209 руб.

Данные расчета экономического эффекта приведены в таблице 6.3.

Таблица 6.3 - Расчет экономического эффекта от использования нового ПС

Показатели	Ед. измер.	Методика расчета	2008	2009	2010	2011
Результаты:
Прирост прибыли за счет экономии затрат	руб.	? Пч	746 862	746 862	746 862	746 862
Сумма прибыли с учетом фактора времени	руб.	? Пч • ALFAt	746 862	672 175	604 958	545 209
Затраты:
Затраты на приобретение ПС	руб.	Кпр	618 312	Х	Х	Х
Затраты на освоение ПС	руб.	Кос	6 183	Х	Х	Х
Затраты на доукомплектование ВТ техническими средствами	руб.	Ктс		Х	Х	Х
Затраты на пополнение оборотных средств	руб.	Коб	12 366	Х	Х	Х
Сумма затрат	руб.	Ко	636 861	0	0	0
Сумма затрат с учетом фактора времени	руб.	Ко • ALFAt	636 861	0	0	0
Экономический эффект	руб.	? Пч • ALFAt -Ко • ALFAt	110 001	672 105	604 958	545 209
Экономический эффект нарастающим итогом	руб.		110 001	782 106	1387 064	1932 273
Коэффициент приведения	ед.	ALFAt	1	0,9	0,81	0,73

Вывод:

Расчет показал, что использование разработанного программного обеспечение к дипломному проекту на тему «Автоматизированный учет радиоточек передающего центра» обеспечивает экономический эффект за четыре года использования ПС на 1 932 273 руб.

Затраты на его приобретение окупятся в первый год использования. Внедрение нового ПС позволит пользователю сэкономить на текущих затратах. Для пользователя в качестве экономического эффекта выступает лишь чистая прибыль, которая остается в его распоряжении.

Таким образом, разработка конкурентоспособна и может быть использована на предприятиях связи.

Литература

В.В. Брага, А.А. Левкин Компьютерные технологии в бухгалтерском учете на базе автоматизированных систем. М.: Финстатинформ, 2001 г., 218с.

Глушаков С.В. Базы данных. М.: Фолио АСТ, 2002 г., 493 с.

Microsoft Access 97. Шаг за шагом: Практ. Пособ./Пер. с англ. -М.: Издательство ЭКОМ, 2000. - 328с.

Маклаков С.В. «BPwin и Erwin CASE средства разработки информационных систем» - М.: издательство «Диалог-Мифи», 2001. - 304 с.

Вендров А.М. «Практикум по проектированию программного обеспечения экономических информационных систем: Учебное пособие» - М.: издательство «Финансы и статистика», 2002. - 192 с.

ГОСТ 12.1.003-83. ССБТ. Шум. Общие требования безопасности.

ГОСТ 12.1.005-88. ССБТ. Общие санитарно-гигиенические требования к воздуху рабочей зоны.

ГОСТ 12.1.012-90.ССБТ. Вибрационная безопасность. Общие требования.

СанПиН 9-131 РБ 2000.

ГОСТ 12.2.032-78. ССБТ. Рабочее место при выполнении работ сидя.

ГОСТ 12.1.030-81. ССБТ.

ГОСТ 6825-91. Лампы люминесцентные трубчатые для общего освещения.

ОНТП 24-8б. Определение категорий помещений и зданий по взрывопожарной и пожарной опасности. -- М.: ВНИИПО МВД СССР, 1988.

СНБ 2.04.05-98. Естественное и искусственное освещение.

СНиП 2.04.05-91.

СН 9-86 РБ-98

НПБ 5-2000

СанПиН 2.2.1.13-5-2006 «Гигиенические требования к проектированию, содержанию и эксплуатации производственных предприятий»

Челноков А.А. Охрана труда: учеб. пособие. - Мн.: Выш. шк., 2007

СНиП 2.2.1.13-5-2006

Приложение А Логическая модель (уровень сущностей)

Приложение Б Логическая модель (уровень ключей)

Приложение В Логическая модель (уровень атрибутов)

Приложение Г Физическая модель данных

Приложение Д Текст программы

- Модуль 1

Option Compare Database

Option Explicit

Public Otch_Per_Pr As Date

Public date_n, date_k As Date

Public vbr As Integer

Public lngX As Long

Function Oplata_aut()

On Error GoTo Oplata_aut_Err

DoCmd.SetWarnings False

Расчет оплаты по месячно перед переходом на следующий месяц

удаляем за данный период

DoCmd.RunSQL "DELETE DISTINCTROW Oplata_auto.*, Oplata_auto.Data_nach FROM Oplata_auto WHERE (((Oplata_auto.Data_nach)>[Forms]![Кнопочная форма]![Otch_per]));"

Подставляем сальдо на начало года как начисление 1 раз

DoCmd.RunSQL "INSERT INTO Oplata_auto ( Abon_opl, Data_nach, Sum_nach ) SELECT DISTINCTROW Partner.CODE, #12/31/2001# AS d1, Abs([Sum_saldo]) AS n FROM Partner INNER JOIN Saldo ON Partner.CODE = Saldo.Code_Ab WHERE (((Saldo.Sum_saldo)<0) AND ((Saldo.Mes)=#1/1/2002#));"

DoCmd.RunSQL "UPDATE DISTINCTROW Oplata_auto SET Oplata_auto.Sum_nach_perv = [Sum_nach];"

Вставляем начисления за период

DoCmd.OpenQuery "a0_1", acNormal, acEdit

DoCmd.OpenQuery "a0_2", acNormal, acEdit

DoCmd.OpenQuery "a0_3", acNormal, acEdit

Сохраняем в Backup

DoCmd.RunSQL "DELETE Oplata_backup.* FROM Oplata_backup;"

DoCmd.RunSQL "INSERT INTO Oplata_backup SELECT Oplata_auto.* FROM Oplata_auto;"

DoCmd.OpenQuery "a1_1", acNormal, acEdit

DoCmd.OpenQuery "a1_2", acNormal, acEdit

DoCmd.OpenQuery "a2_1", acNormal, acEdit

DoCmd.OpenQuery "a2_2", acNormal, acEdit

DoCmd.OpenQuery "a2_3", acNormal, acEdit

DoCmd.OpenQuery "a2_4", acNormal, acEdit

DoCmd.OpenQuery "a3_1", acNormal, acEdit

DoCmd.OpenQuery "a3_2", acNormal, acEdit

DoCmd.OpenQuery "a3_3", acNormal, acEdit

DoCmd.OpenQuery "a3_4", acNormal, acEdit

DoCmd.OpenQuery "a3_5", acNormal, acEdit

DoCmd.OpenQuery "_mes_opl", acNormal, acEdit 'Группировка месяц

DoCmd.OpenQuery "a4_1", acNormal, acEdit 'sort!!!

DoCmd.OpenQuery "a4_2", acNormal, acEdit

DoCmd.OpenQuery "a4_3", acNormal, acEdit

DoCmd.OpenQuery "a4_4", acNormal, acEdit

Удаляем из tempa

DoCmd.RunSQL "DELETE DISTINCTROW [_temp].* FROM _temp;"

Oplata_aut_Exit:

Exit Function

Oplata_aut_Err:

MsgBox Error$

Resume Oplata_aut_Exit

End Function

Function Saldo_new()

On Error GoTo Saldo_new_Err

DoCmd.SetWarnings False

'Расчет сальдо перед переходом на следующий месяц

DoCmd.OpenQuery "Z_Udal_Saldo", acNormal, acEdit

DoCmd.OpenQuery "R_Saldo_new", acNormal, acEdit

Saldo_new_Exit:

Exit Function

Saldo_new_Err:

MsgBox Error$

Resume Saldo_new_Exit

End Function

Function Rashet_nachisl()

On Error GoTo Rashet_nachisl_Err

DoCmd.SetWarnings False

DoCmd.OpenQuery "R_nach_ud", acNormal, acEdit

DoCmd.OpenQuery "R_nach", acNormal, acEdit

DoCmd.OpenQuery "R_nach_7", acNormal, acEdit

treb_begin

Rashet_nachisl_Exit:

Exit Function

Rashet_nachisl_Err:

MsgBox Error$

Resume Rashet_nachisl_Exit

End Function

Function Pech_reestr()

On Error GoTo Pech_reestr_Err

vbr = 2

DoCmd.OpenForm "Требования", acFormDS, "", "", acEdit, acNormal

Pech_reestr_Exit:

Exit Function

Pech_reestr_Err:

MsgBox Error$

Resume Pech_reestr_Exit

End Function

Function Pech_reestr_in()

On Error GoTo Pech_reestr_in_Err

vbr = 3

DoCmd.OpenForm "Требования", acFormDS, "", "", acEdit, acNormal

Pech_reestr_in_Exit:

Exit Function

Pech_reestr_in_Err:

MsgBox Error$

Resume Pech_reestr_in_Exit

End Function

'------------------------------------------------------------

' Требования

'

'------------------------------------------------------------

Function Pech_treb()

On Error GoTo Pech_treb_Err

vbr = 1

DoCmd.OpenForm "Требования", acFormDS, "", "", acEdit, acNormal

Pech_treb_Exit:

Exit Function

Pech_treb_Err:

MsgBox Error$

Resume Pech_treb_Exit

End Function

Function Pech_kol_usl()

On Error GoTo Pech_kol_usl_Err

DoCmd.SetWarnings False

DoCmd.RunSQL "DELETE DISTINCTROW SCHET.* FROM SCHET;"

DoCmd.OpenQuery "Z_Uslugi_vid_1", acNormal, acEdit

DoCmd.OpenQuery "Z_Uslugi_vid_2", acNormal, acEdit

DoCmd.OpenQuery "Z_Uslugi_vid_3", acNormal, acEdit

DoCmd.RunSQL "UPDATE DISTINCTROW abon_sys SET abon_sys.CODE = 5;"

run_exe

Pech_kol_usl_Exit:

Exit Function

Pech_kol_usl_Err:

MsgBox Error$

Resume Pech_kol_usl_Exit

End Function

Function Open_Dialog(stArg_d As String)

On Error GoTo Open_Dialog_Err

' DoCmd.SetWarnings False

DoCmd.OpenForm "Диалог", acNormal, "", "", acEdit, acNormal, stArg_d

Open_Dialog_Exit:

Exit Function

Open_Dialog_Err:

MsgBox Error$

Resume Open_Dialog_Exit

End Function

Function Open_Data_dialog() '(stArg_d As String)

On Error GoTo Open_Data_dialog_Err

' DoCmd.SetWarnings False

DoCmd.OpenForm "Ввод даты", acNormal, "", "", acEdit, acNormal ', stArg_d

Open_Data_dialog_Exit:

Exit Function

Open_Data_dialog_Err:

MsgBox Error$

Resume Open_Data_dialog_Exit

End Function

Function run_exe()

On Error GoTo Err_run_exe

Dim stAppName As String

stAppName = "C:\Abon\ABON_ORG.EXE"

Call Shell(stAppName, 3)

Exit_run_exe:

Exit Function

Err_run_exe:

MsgBox Err.Description

Resume Exit_run_exe

End Function

Function Откр_форму(Name_form As String)

On Error GoTo Откр_форму_Err

DoCmd.OpenForm Name_form, acFormDS, "", "", acEdit, acNormal

Откр_форму_Exit:

Exit Function

Откр_форму_Err:

MsgBox Error$

Resume Откр_форму_Exit

End Function

'------------------------------------------------------------

' Переход_Back

'

'------------------------------------------------------------

Function Переход_Back() '(Name_form As Form)

On Error GoTo Переход_Back_Err

Dim Dat_N As Date, Dat_T As Date

Dat_T = DateSerial(Year(DLookup("DateValue (Запись)", "Системная", "Код = 1")), Month(DLookup("DateValue (Запись)", "Системная", "Код = 1")), Day(DLookup("DateValue (Запись)", "Системная", "Код = 1")))

Dat_N = DateSerial(Year(DLookup("DateValue (Запись)", "Системная", "Код = 1")), Month(DLookup("DateValue (Запись)", "Системная", "Код = 1")) - 1, Day(DLookup("DateValue (Запись)", "Системная", "Код = 1")))

If MsgBox("Текущий отчетный период" & Chr(13) & Chr(10) & _

Format(Dat_T, "mmmm yyyy") & Chr(13) & Chr(10) & _

"Следующий - " & Format(Dat_N, "mmmm yyyy") & Chr(13) & Chr(10) & _

"Будете переходить?", vbYesNo + vbInformation + vbDefaultButton1) = vbYes Then

Forms![Кнопочная форма]![Otch_per] = Dat_N

Otch_Per_Pr = Dat_N

DoCmd.SetWarnings False

DoCmd.RunSQL "UPDATE DISTINCTROW Системная SET Системная.Запись = '" & Dat_N & "' WHERE (((Системная.Код)=1));"

Dat_N = DateSerial(Year(Otch_Per_Pr), Month(Otch_Per_Pr) - 1, Day(Otch_Per_Pr))

DoCmd.RunSQL "UPDATE DISTINCTROW Системная SET Системная.Запись = '" & Dat_N & "' WHERE (((Системная.Код)=2));"

Dat_N = DateSerial(Year(Otch_Per_Pr), Month(Otch_Per_Pr) + 1, Day(Otch_Per_Pr))

DoCmd.RunSQL "UPDATE DISTINCTROW Системная SET Системная.Запись = '" & Dat_N & "' WHERE (((Системная.Код)=3));"

DoCmd.RunSQL "DELETE Oplata_auto.* FROM Oplata_auto;"

DoCmd.RunSQL "INSERT INTO Oplata_auto SELECT Oplata_backup.* FROM Oplata_backup;"

End If

Переход_Back_Exit:

Exit Function

Переход_Back_Err:

MsgBox Error$

Resume Переход_Back_Exit

End Function

'------------------------------------------------------------

' Переход_New

'

'------------------------------------------------------------

Function Переход_New() '(Name_form As Form)

On Error GoTo Переход_New_Err

Dim Dat_N As Date, Dat_T As Date

Dat_T = DateSerial(Year(DLookup("DateValue (Запись)", "Системная", "Код = 1")), Month(DLookup("DateValue (Запись)", "Системная", "Код = 1")), Day(DLookup("DateValue (Запись)", "Системная", "Код = 1")))

Dat_N = DateSerial(Year(DLookup("DateValue (Запись)", "Системная", "Код = 1")), Month(DLookup("DateValue (Запись)", "Системная", "Код = 1")) + 1, Day(DLookup("DateValue (Запись)", "Системная", "Код = 1")))

If MsgBox("Текущий отчетный период" & Chr(13) & Chr(10) & _

Format(Dat_T, "mmmm yyyy") & Chr(13) & Chr(10) & _

"Следующий - " & Format(Dat_N, "mmmm yyyy") & Chr(13) & Chr(10) & _

"Будете переходить?", vbYesNo + vbInformation + vbDefaultButton1) = vbYes Then

'LineNew:

Oplata_aut

Saldo_new

Forms![Кнопочная форма]![Otch_per] = Dat_N

Otch_Per_Pr = Dat_N

DoCmd.SetWarnings False

DoCmd.RunSQL "UPDATE DISTINCTROW Системная SET Системная.Запись = '" & Dat_N & "' WHERE (((Системная.Код)=1));"

Dat_N = DateSerial(Year(Otch_Per_Pr), Month(Otch_Per_Pr) - 1, Day(Otch_Per_Pr))

DoCmd.RunSQL "UPDATE DISTINCTROW Системная SET Системная.Запись = '" & Dat_N & "' WHERE (((Системная.Код)=2));"

Dat_N = DateSerial(Year(Otch_Per_Pr), Month(Otch_Per_Pr) + 1, Day(Otch_Per_Pr))

DoCmd.RunSQL "UPDATE DISTINCTROW Системная SET Системная.Запись = '" & Dat_N & "' WHERE (((Системная.Код)=3));"

'заполнение чистыми бланками требований

DoCmd.RunSQL "DELETE DISTINCTROW Treb.*, Treb.Data_nach FROM Treb WHERE (((Treb.Data_nach) Is Null));"

DoCmd.RunSQL "INSERT INTO Treb ( Code, Abon_nach ) SELECT DISTINCTROW [Partner]![CODE] & Format([Forms]![Кнопочная форма]![Otch_per],'mmyy') AS COD, Partner.CODE FROM Partner;"

Else

End If

Переход_New_Exit:

Exit Function

Переход_New_Err:

MsgBox Error$

Resume Переход_New_Exit

End Function

Public Function Del_period()

'Убираем меньше заданного периода

Dim Per_0 As String

' Per_0 = DateSerial(Year(DLookup("DateValue (Запись)", "Системная", "Код = 10")), Month(DLookup("DateValue (Запись)", "Системная", "Код = 10")), Day(DLookup("DateValue (Запись)", "Системная", "Код = 10")))

' Per_0 = DLookup("Запись", "Системная", "Код = 10")

Per_0 = "01/01/2002"

DoCmd.SetWarnings True

DoCmd.RunSQL "DELETE DISTINCTROW Nachisl.*, Nachisl.Data_nach FROM Nachisl WHERE (((Nachisl.Data_nach) < #" & Per_0 & "#));"

DoCmd.RunSQL "DELETE DISTINCTROW Oplata.*, Oplata.Data_oplat FROM Oplata WHERE (((Oplata.Data_oplat) < #" & Per_0 & "#));"

DoCmd.RunSQL "DELETE DISTINCTROW Saldo.*, Saldo.Mes FROM Saldo WHERE (((Saldo.Mes) < #" & Per_0 & "#));"

DoCmd.RunSQL "DELETE DISTINCTROW Treb.*, Treb.Data_nach FROM Treb WHERE (((Treb.Data_nach) < #" & Per_0 & "#));"

End Function

Public Function treb_begin()

DoCmd.SetWarnings False

DoCmd.RunSQL "DELETE DISTINCTROW Plat_tr.* FROM Plat_tr;"

DoCmd.RunSQL "INSERT INTO PLAT_TR ( CODE_TR, SUM_NACH, NDS_NACH, SUM_VSEGO ) SELECT DISTINCTROW Partner.CODE, Sum(Сумма_начислений.Sum_Sum_nach) AS Sum_Sum_Sum_nach, Sum(Сумма_начислений.Sum_NDS_nach) AS Sum_Sum_NDS_nach, Sum([Sum_Sum_nach]+[Sum_NDS_nach]) AS SUM_VSEGO FROM Partner INNER JOIN [Сумма_начислений] ON Partner.CODE = Сумма_начислений.Abon_nach GROUP BY Partner.CODE;"

DoCmd.OpenQuery "Обновл_Требован"

End Function

- Модуль для перевода чисел в текст прописью:

' определение внешней функции NumberToText

Private Declare Function NumberToText Lib "DIG2TEXT" (ByVal Num As Double, ByVal ObjID$, ByVal flags As Long, ByVal ResultVal$) As Long

Function CapitalizeFirst(Str)

' Переводит первую букву в поле на верхний регистр;

' оставляет остальные символы не измененными.

Dim strTemp As String

strTemp = Trim(Str)

CapitalizeFirst = UCase(Left(strTemp, 1)) & Mid(strTemp, 2)

End Function

Function Okruglen(Num As Currency)

Okruglen = Format(Num, "#0.00")

End Function

' Spaces256$ создает пустую строку длиной 256 символов

Function Spaces256$()

Temp$ = "0123456789abcdef"

Temp$ = Temp$ & Temp$ & Temp$ & Temp$

Temp$ = Temp$ & Temp$ & Temp$ & Temp$

Spaces256$ = Temp$

End Function

' NumberToRussianText$ преобразует число Number в строку, в которой это число записано прописью

' на русском языке в соответствии с объектом ObjectID$. Если Flags = 256, то первый символ строки

' делается заглавным.

Function NumberToRussianText$(Number As Double, ObjectID$, flags As Long)

Dim ResultVal$, ResultLength As Long

ResultVal$ = Spaces256$()

ResultLength = NumberToText(Number, ObjectID$, flags, ResultVal$)

NumberToRussianText$ = Left$(ResultVal$, ResultLength)

End Function

' Пример использования функции NumberToRussianText$

'Sub ConvertToRusTextExample()

' ResultVal$ = NumberToRussianText$(123.5, "USD", 256)

' Debug.Print ResultVal$

'End Sub

- Модуль для служебных функций

Option Compare Database

Option Explicit

Public Kod_typ_dv As Integer

Public Archif As Boolean

Public Board As Integer

Public Obn As Boolean

'------------------------------------------------------------

' Restore_Form

'

'------------------------------------------------------------

Function Restore_Form(Name_form As Form)

On Error GoTo Restore_Form_Err

Dim frm As Form

Set frm = Name_form

frm.SetFocus

DoCmd.Restore

Restore_Form_Exit:

Exit Function

Restore_Form_Err:

MsgBox Error$

Resume Restore_Form_Exit

End Function

Sub Set_Controls(Dostup As Integer)

'1- Запретить изменения, 2- разрешить

On Error GoTo Set_Controls_Err

Dim frm As Form, ctl As Control, D As Integer

Set frm = Screen.ActiveForm

' Перебирает все компоненты семейства Controls.

For Each ctl In frm.Controls

' Проверяет, является ли элемент управления списком или текстовым блоком

If ctl.ControlType = acComboBox Or ctl.ControlType = acTextBox Then

If Dostup = 1 Then

If ctl.Name = "ПолеПоиска" Then

Else

With ctl

.Enabled = False

.Locked = True

' .SetFocus

' .OnEnter = "=Вход_ПолеСоСписком()"

' .OnExit = "=Выход_ПолеСоСписком()"

End With

End If

ElseIf Dostup = 2 Then

With ctl

' .SetFocus

.Enabled = True

.Locked = False

End With

End If

End If

Next ctl

Set_Controls_Exit:

Exit Sub

Set_Controls_Err:

MsgBox Error$

Resume Set_Controls_Exit

End Sub

'------------------------------------------------------------

' Close_Form

'

'------------------------------------------------------------

Function Close_Form()

On Error GoTo Close_Form_Err

Dim strFormName As String

' strFormName = Screen.ActiveDatasheet.Name

strFormName = Screen.ActiveForm.FormName

' DoCmd.Close acQuery, strFormName, acSaveYes

If strFormName = "Кнопочная форма" Then

SendKeys "{ESC}", False

Else

DoCmd.Close acForm, strFormName, acSaveYes

End If

Close_Form_Exit:

Exit Function

Close_Form_Err:

If Err.Number = 2475 Then

strFormName = Screen.ActiveDatasheet.Name

DoCmd.Close acQuery, strFormName, acSaveYes

'frm.SetFocus

DoCmd.Restore

'Restore_Form ("Forms![Кнопочная форма]")

Else

' MsgBox Error$

Resume Close_Form_Exit

End If

End Function

Function Exit_Main()

DoCmd.Quit acSave

End Function

Function IsForm(NameForm As String) As Integer

' Возвращает True, если актиным окном является форма.

Dim strFormName As String

On Error Resume Next

strFormName = Screen.ActiveForm.FormName

If Err Then

IsForm = False

Else

If strFormName = NameForm Then

IsForm = True

Else

IsForm = False

End If

End If

On Error GoTo 0

End Function

Function EditN() As Integer

On Error GoTo EditN_Err

Dim frm As Form

Dim varTmp As Variant

Set frm = Screen.ActiveForm

' Включает ввод записей с помощью свойства

' "Разрешить изменение" (AllowEdits). Задает для свойства

' "Работа с записями" (DefaultEditing) значение 1 (Ввод данных).

' frm.AllowEdits = False

'frm.DefaultEditing = 1

' Включает элементы в области данных

varTmp = EnableControls("Detail", False, True)

Exit Function

EditN_Err:

MsgBox Err.Description

Exit Function

End Function

Function EditD() As Integer

On Error GoTo EditD_Err

Dim frm As Form

Dim varTmp As Variant

Set frm = Screen.ActiveForm

' Включает ввод записей с помощью свойства

' "Разрешить изменение" (AllowEdits). Задает для свойства

' "Работа с записями" (DefaultEditing) значение 1 (Ввод данных).

' frm.AllowEdits = True

'frm.DefaultEditing = 1

' Включает элементы в области данных

varTmp = EnableControls("Detail", True, False)

Exit Function

EditD_Err:

MsgBox Err.Description

Exit Function

End Function

Function EnableControls(strWhichSection As String, intState As Integer, intLocked As Integer) As Integer

' Включает и отключает элементы управления в указанных разделах формы.

Dim frm As Form

Dim ctl As Control

Dim intX As Integer, intSelectedSection As Integer

' Использует активную форму. Если активной формы нет,

' осуществляет выход из формы без вывода сообщения об ошибке.

On Error Resume Next

Set frm = Screen.ActiveForm

If Err Then

EnableControls = False

On Error GoTo 0

Exit Function

End If

' Определяет допустимые значения аргумента strWhichSection.

Select Case UCase$(strWhichSection)

Case "FORM HEADER"

intSelectedSection = 1

Case "PAGE HEADER"

intSelectedSection = 3

Case "DETAIL"

intSelectedSection = 0

Case "PAGE FOOTER"

intSelectedSection = 4

Case "FORM FOOTER"

intSelectedSection = 2

Case Else

MsgBox "Недопустимый аргумент", , "EnableControls"

EnableControls = False

Exit Function

End Select

' Присваивает значение аргумента intState, intLocked всем

' элементам управления в указанном разделе.

For intX = 0 To frm.Count - 1

Set ctl = frm(intX)

If ctl.Section = intSelectedSection Then

On Error Resume Next

ctl.Enabled = intState

ctl.Locked = intLocked

On Error GoTo 0

End If

Next intX

EnableControls = True

End Function

'------------------------------------------------------------

' К_полю_поиска

'

'------------------------------------------------------------

Function К_полю_поиска()

On Error GoTo К_полю_поиска_Err

Dim Fr As Form

Set Fr = Screen.ActiveForm

Fr![ПолеПоиска].SetFocus

SendKeys "{F4}", False

К_полю_поиска_Exit:

Exit Function

К_полю_поиска_Err:

MsgBox Error$

Resume К_полю_поиска_Exit

End Function

Function Перед_обновлением()

Dim strMsg As String, strCRLF As String

strCRLF = Chr(13) & Chr(10)

strMsg = "Произведено изменение." & strCRLF & _

"Если все правильно, нажмите Да. Произойдет запись." & strCRLF & _

"При нажатии Нет запись не произойдет," & strCRLF & _

"а при последующем нажатии клавиши Esc отмените изменения."

If MsgBox(strMsg, vbYesNo + vbQuestion + vbDefaultButton2) = vbNo Then

Перед_обновлением = -1

End If

End Function

Function Печать_отчета(stDocName As String)

On Error GoTo Err_Печать_отчета

Dim stDocName1 As String

'stDocName = "Z_Abon_КолПоУлицам"

stDocName1 = stDocName

DoCmd.OpenReport stDocName1, acNormal

Exit_Печать_отчета:

Exit Function

Err_Печать_отчета:

MsgBox Err.Description

Resume Exit_Печать_отчета

End Function

'В данном примере функция IsNull проверяет, имеет ли элемент

'управления пустое (Null) значение.

'Если да, выводится приглашение ввести данные.

'Если элемент управления имеет присвоенное значение,

'выводится сообщение с этим значением.

Sub ControlValue(ctlText As Control)

Dim strMsg As String, strCRLF As String

strCRLF = Chr(13) & Chr(10)

' Проверяет, что элемент управления является полем.

If ctlText.ControlType = acTextBox Then

' При значении Null выводит приглашение ввести данные.

If IsNull(ctlText.Value) Then

strMsg = "Пустое поле '" & _

ctlText.Name & "'." & strCRLF & _

"Введите значение данного поля."

If MsgBox(strMsg, vbQuestion) = vbOK Then

Exit Sub

End If

' Если поле имеет непустое значение, выводит это значение.

Else

MsgBox (ctlText.Value)

End If

End If

End Sub

Function IsLoaded1(ByVal strFormName As String) As Integer

' Возвращает значения True, если форма открыта в режиме формы или таблицы.

Const conObjStateClosed = 0

Const conDesignView = 0

If SysCmd(acSysCmdGetObjectState, acForm, strFormName) <> conObjStateClosed Then

If Forms(strFormName).CurrentView <> conDesignView Then

IsLoaded1 = True

End If

End If

End Function

Function IsLoaded(frmName)

' Проверяет, загружена ли форма.

Const conFormDesign = 0

Dim intX As Integer

IsLoaded = False

For intX = 0 To Forms.Count - 1

If Forms(intX).FormName = frmName Then

If Forms(intX).CurrentView <> conFormDesign Then

IsLoaded = True

Exit Function ' Выход из функции при обнаружении формы.

End If

End If

Next

End Function

'------------------------------------------------------------

' Команды_УдЗап

'

'------------------------------------------------------------

Function Команды_УдЗап()

On Error GoTo Команды_УдЗап_Err

DoCmd.DoMenuItem 0, 1, 7, 0, acMenuVer70 ' Форма, Правка, Удалить запись

Команды_УдЗап_Exit:

Exit Function

Команды_УдЗап_Err:

MsgBox Error$

Resume Команды_УдЗап_Exit

End Function

'------------------------------------------------------------

' Команды_Обновить

'

'------------------------------------------------------------

Function Команды_Обновить()

On Error GoTo Команды_Обновить_Err

DoCmd.Requery ""

Команды_Обновить_Exit:

Exit Function

Команды_Обновить_Err:

MsgBox Error$

Resume Команды_Обновить_Exit

End Function

'------------------------------------------------------------

' Команды_ДобавитьЗап

'

'------------------------------------------------------------

Function Команды_ДобавитьЗап()

On Error GoTo Команды_ДобавитьЗап_Err

DoCmd.DoMenuItem 0, 3, 0, 0, acMenuVer70 ' Форма, Вставка, Запись

Команды_ДобавитьЗап_Exit:

Exit Function

Команды_ДобавитьЗап_Err:

MsgBox Error$

Resume Команды_ДобавитьЗап_Exit

End Function