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

 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 руб.

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

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

Литература

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

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

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

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

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

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

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

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

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

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

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

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

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

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

15.            СНиП 2.04.05-91.

16.            СН 9-86 РБ-98

17.            НПБ 5-2000

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

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

20.       СНиП 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