2.3 Программная реализация алгоритмов

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

Загрузка базы данных и диалоговое окно «Информация»

Option Compare Database

Option Explicit

Function OpenStartup() As Boolean

On Error GoTo OpenStartup_Err

If IsItAReplica() Then

DoCmd.Close

Else

If (CurrentDb().Properties("StartupForm") = "Информация" Or _

CurrentDb().Properties("StartupForm") = "Form.Информация") Then

Forms!Информация!HideStartupForm = False

Else

Forms!Информация!HideStartupForm = True

End If

End If

OpenStartup_Exit:

Exit Function

OpenStartup_Err:

Const conPropertyNotFound = 3270

If Err = conPropertyNotFound Then

Forms!Информация!HideStartupForm = True

Resume OpenStartup_Exit

End If

End Function

Function HideStartupForm()

On Error GoTo HideStartupForm_Err

If Forms!Информация!HideStartupForm Then

CurrentDb().Properties("StartupForm") = "Главная кнопочная форма"

Else

CurrentDb().Properties("StartupForm") = "Информация"

End If

Exit Function

HideStartupForm_Err:

Const conPropertyNotFound = 3270

If Err = conPropertyNotFound Then

Dim db As DAO.Database

Dim prop As DAO.Property

Set db = CurrentDb()

Set prop = db.CreateProperty("StartupForm", dbText, "Информация")

db.Properties.Append prop

Resume Next

End If

End Function

Function CloseForm()

DoCmd.Close

DoCmd.OpenForm ("Главная кнопочная форма")

End Function

Function IsItAReplica() As Boolean

On Error GoTo IsItAReplica_Err

Dim blnReturnValue As Boolean

blnReturnValue = False

If CurrentDb().Properties("Replicable") = "T" Then

blnReturnValue = True

Else

blnReturnValue = False

End If

IsItAReplica_Exit:

IsItAReplica = blnReturnValue

Exit Function

IsItAReplica_Err:

Resume IsItAReplica_Exit

End Function

Главная кнопочная форма

Option Compare Database

Option Explicit

Function OpenForms(strFormName As String) As Integer

On Error GoTo Err_OpenForms

DoCmd.OpenForm strFormName

Exit_OpenForms:

Exit Function

Err_OpenForms:

MsgBox Err.Description

Resume Exit_OpenForms

End Function

Function OpenQuery(strQueryName As String) As Integer

On Error GoTo Err_OpenQuery

DoCmd.OpenQuery strQueryName

Exit_OpenQuery:

Exit Function

Err_OpenQuery:

MsgBox Err.Description

Resume Exit_OpenQuery

End Function

Sub ВыходИзMicrosoftAccess_Click()

On Error GoTo Err_ExitMicrosoftAccess_Click

DoCmd.Quit

Exit_ExitMicrosoftAccess_Click:

Exit Sub

Err_ExitMicrosoftAccess_Click:

MsgBox Err.Description

Resume Exit_ExitMicrosoftAccess_Click

End Sub

Sub ОкноБазыДанных_Click()

On Error GoTo Err_ОкноБазыДанных_Click

Dim strDocName As String

strDocName = "Кадры"

DoCmd.Close

DoCmd.SelectObject acTable, strDocName, True

Exit_ ОкноБазыДанных _Click:

Exit Sub

Err_ ОкноБазыДанных_Click:

MsgBox Err.Description

Resume Exit_ ОкноБазыДанных_Click

End Sub