Автоматизированная информационная система детского сада "Солнышко"

Формат: doc

Дата создания: 02.03.2006

Размер: 18.8 KB

Скачать дипломную работу

Приложение

Option Compare Database

Private Sub Form_Open(Cancel As Integer)

' Minimize the database window and initialize the form.

' Move to the switchboard page that is marked as the default.

Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Поумолчанию' "

Me.FilterOn = True

End Sub

Private Sub Form_Current()

' Update the caption and fill in the list of options.

Me.Caption = Nz(Me![ItemText], "")

FillOptions

End Sub

Private Sub FillOptions()

' Fill in the options for this switchboard page.

' The number of buttons on the form.

Const conNumButtons = 8

Dim con As Object

Dim rs As Object

Dim stSql As String

Dim intOption As Integer

' Set the focus to the first button on the form,

' and then hide all of the buttons on the form

' but the first. You can't hide the field with the focus.

' Open the table of Switchboard Items, and find

' the first item for this Switchboard Page.

Set con = Application.CurrentProject.Connection

stSql = "SELECT * FROM [Switchboard Items]"

stSql = stSql & " WHERE [ItemNumber] > 0 AND [SwitchboardID]=" & Me![SwitchboardID]

stSql = stSql & " ORDER BY [ItemNumber];"

Set rs = CreateObject("ADODB.Recordset")

rs.Open stSql, con, 1 ' 1 = adOpenKeyset

' If there are no options for this Switchboard Page,

' display a message. Otherwise, fill the page with the items.

Set rs = Nothing

Set con = Nothing

End Sub

Private Function HandleButtonClick(intBtn As Integer)

' This function is called when a button is clicked.

' intBtn indicates which button was clicked.

' Constants for the commands that can be executed.

Const conCmdGotoSwitchboard = 1

Const conCmdOpenFormAdd = 2

Const conCmdOpenFormBrowse = 3

Const conCmdOpenReport = 4

Const conCmdCustomizeSwitchboard = 5

Const conCmdExitApplication = 6

Const conCmdRunMacro = 7

Const conCmdRunCode = 8

Const conCmdOpenPage = 9

' An error that is special cased.

Const conErrDoCmdCancelled = 2501

Dim con As Object

Dim rs As Object

Dim stSql As String

On Error GoTo HandleButtonClick_Err

' Find the item in the Switchboard Items table

' that corresponds to the button that was clicked.

Set con = Application.CurrentProject.Connection

Set rs = CreateObject("ADODB.Recordset")

stSql = "SELECT * FROM [Switchboard Items] "

stSql = stSql & "WHERE [SwitchboardID]=" & Me![SwitchboardID] & " AND [ItemNumber]=" & intBtn

rs.Open stSql, con, 1 ' 1 = adOpenKeyset

' If no item matches, report the error and exit the function.

If (rs.EOF) Then

MsgBox "Ошибкапричтениитаблицы Switchboard Items."

rs.Close

Set rs = Nothing

Set con = Nothing

Exit Function

End If

Select Case rs![Command]

' Go to another switchboard.

Case conCmdGotoSwitchboard

Me.Filter = "[ItemNumber] = 0 AND [SwitchboardID]=" & rs![Argument]

' Open a form in Add mode.

Case conCmdOpenFormAdd

DoCmd.OpenForm rs![Argument], , , , acAdd

' Open a form.

Case conCmdOpenFormBrowse

DoCmd.OpenForm rs![Argument]

' Open a report.

Case conCmdOpenReport

DoCmd.OpenReport rs![Argument], acPreview

' Customize the Switchboard.

Case conCmdCustomizeSwitchboard

' Handle the case where the Switchboard Manager

' is not installed (e.g. Minimal Install).

On Error Resume Next

Application.Run "ACWZMAIN.sbm_Entry"

If (Err <> 0) Then MsgBox "Команда недоступна."

On Error GoTo 0

' Update the form.

Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Поумолчанию' "

Me.Caption = Nz(Me![ItemText], "")

FillOptions

' Exit the application.

Case conCmdExitApplication

CloseCurrentDatabase

' Run a macro.

Case conCmdRunMacro

DoCmd.RunMacro rs![Argument]

' Run code.

Case conCmdRunCode

Application.Run rs![Argument]

' Open a Data Access Page

Case conCmdOpenPage

DoCmd.OpenDataAccessPage rs![Argument]

' Any other command is unrecognized.

Case Else

MsgBox "Неизвестная команда."

End Select

' Close the recordset and the database.

rs.Close

HandleButtonClick_Exit:

On Error Resume Next

Set rs = Nothing

Set con = Nothing

Exit Function

HandleButtonClick_Err:

' If the action was cancelled by the user for

' some reason, don't display an error message.

' Instead, resume on the next line.

If (Err = conErrDoCmdCancelled) Then

Resume Next

Else

MsgBox "Ошибка при выполнении команды.", vbCritical

Resume HandleButtonClick_Exit

End If

End Function

Private Sub Label1_Click()

End Sub

Private Sub Option1_Click()

End Sub

Private Sub Кнопка22_Click()

DoCmd.Close

End Sub

Private Sub Кнопка32_Click()

On Error GoTo Err_Кнопка32_Click

Dim stDocName As String

stDocName = ChrW(1056) & ChrW(1086) & ChrW(1076) & ChrW(1089) & ChrW(1090) & ChrW(1074) & ChrW(1077) & ChrW(1085) & ChrW(1085) & ChrW(1080) & ChrW(1082) & ChrW(1080)

DoCmd.OpenReport stDocName, acPreview

Exit_Кнопка32_Click:

Exit Sub

Err_Кнопка32_Click:

MsgBox Err.Description

Resume Exit_Кнопка32_Click

End Sub

Private Sub Кнопка33_Click()

On Error GoTo Err_Кнопка33_Click

Dim stDocName As String

stDocName = ChrW(1056) & ChrW(1077) & ChrW(1073) & ChrW(1105) & ChrW(1085) & ChrW(1086) & ChrW(1082)

DoCmd.OpenReport stDocName, acPreview

Exit_Кнопка33_Click:

Exit Sub

Err_Кнопка33_Click:

MsgBox Err.Description

Resume Exit_Кнопка33_Click

End Sub

Private Sub Кнопка34_Click()

On Error GoTo Err_Кнопка34_Click

Dim stDocName As String

stDocName = ChrW(1043) & ChrW(1088) & ChrW(1091) & ChrW(1087) & ChrW(1087) & ChrW(1099)

DoCmd.OpenReport stDocNa me, acPreview

Exit_Кнопка34_Click:

Exit Sub

Err_Кнопка34_Click:

MsgBox Err.Description

Resume Exit_Кнопка34_Click

End Sub

Private Sub Кнопка37_Click()

On Error GoTo Err_Кнопка37_Click

Dim stDocName As String

stDocName = ChrW(1057) & ChrW(1090) & ChrW(1072) & ChrW(1090) & ChrW(1080) & ChrW(1089) & ChrW(1090) & ChrW(1080) & ChrW(1082) & ChrW(1072)

DoCmd.OpenReport stDocName, acPreview

Exit_Кнопка37_Click:

Exit Sub

Err_Кнопка37_Click:

MsgBox Err.Description

Resume Exit_Кнопка37_Click

End Sub

Private Sub Кнопка51_Click()

On Error GoTo Err_Кнопка51_Click

Dim stDocName As String

Dim MyForm As Form

stDocName = ChrW(1057) & ChrW(1086) & ChrW(1090) & ChrW(1088) & ChrW(1091) & ChrW(1076) & ChrW(1085) & ChrW(1080) & ChrW(1082) & ChrW(1080)

Set MyForm = Screen.ActiveForm

DoCmd.SelectObject acTable, stDocName, True

DoCmd.PrintOut

DoCmd.SelectObject acForm, MyForm.Name, False

Exit_Кнопка51_Click:

Exit Sub

Err_Кнопка51_Click:

MsgBox Err.Description

Resume Exit_Кнопка51_Click

End Sub

Private Sub Кнопка52_Click()

On Error GoTo Err_Кнопка52_Click

Dim stDocName As String

Dim MyForm As Form

stDocName = ChrW(1056) & ChrW(1086) & ChrW(1076) & ChrW(1089) & ChrW(1090) & ChrW(1074) & ChrW(1077) & ChrW(1085) & ChrW(1085) & ChrW(1080) & ChrW(1082) & ChrW(1080)

Set MyForm = Screen.ActiveForm

DoCmd.SelectObject acTable, stDocName, True

DoCmd.PrintOut

DoCmd.SelectObject acForm, MyForm.Name, False

Exit_Кнопка52_Click:

Exit Sub

Err_Кнопка52_Click:

MsgBox Err.Description

Resume Exit_Кнопка52_Click

End Sub

Private Sub Кнопка53_Click()

On Error GoTo Err_Кнопка53_Click

Dim stDocName As String

stDocName = ChrW(1043) & ChrW(1088) & ChrW(1091) & ChrW(1087) & ChrW(1087) & ChrW(1099)

DoCmd.OpenReport stDocName, acNormal

Exit_Кнопка53_Click:

Exit Sub

Err_Кнопка53_Click:

MsgBox Err.Description

Resume Exit_Кнопка53_Click

End Sub

Private Sub Кнопка54_Click()

On Error GoTo Err_Кнопка54_Click

Dim stDocName As String

stDocName = ChrW(1057) & ChrW(1086) & ChrW(1090) & ChrW(1088) & ChrW(1091) & ChrW(1076) & ChrW(1085) & ChrW(1080) & ChrW(1082) & ChrW(1080) & ChrW(49)

DoCmd.OpenReport stDocName, acNormal

Exit_Кнопка54_Click:

Exit Sub

Err_Кнопка54_Click:

MsgBox Err.Description

Resume Exit_Кнопка54_Click

End Sub

Private Sub Кнопка55_Click()

On Error GoTo Err_Кнопка55_Click

Dim stDocName As String

stDocName = ChrW(1056) & ChrW(1086) & ChrW(1076) & ChrW(1089) & ChrW(1090) & ChrW(1074) & ChrW(1077) & ChrW(1085) & ChrW(1085) & ChrW(1080) & ChrW(1082) & ChrW(1080)

DoCmd.OpenReport stDocName, acNormal

Exit_Кнопка55_Click:

Exit Sub

Err_Кнопка55_Click:

MsgBox Err.Description

Resume Exit_Кнопка55_Click

End Sub

Private Sub Кнопка56_Click()

On Error GoTo Err_Кнопка56_Click

Dim stDocName As String

stDocName = ChrW(1043) & ChrW(1088) & ChrW(1091) & ChrW(1087) & ChrW(1087) & ChrW(1099)

DoCmd.OpenReport stDocName, acNormal

Exit_Кнопка56_Click:

Exit Sub

Err_Кнопка56_Click:

MsgBox Err.Description

Resume Exit_Кнопка56_Click

End Sub

Private Sub Кнопка57_Click()

On Error GoTo Err_Кнопка57_Click

Dim stDocName As String

stDocName = ChrW(1056) & ChrW(1077) & ChrW(1073) & ChrW(1105) & ChrW(1085) & ChrW(1086) & ChrW(1082)

DoCmd.OpenReport stDocName, acNormal

Exit_Кнопка57_Click:

Exit Sub

Err_Кнопка57_Click:

MsgBox Err.Description

Resume Exit_Кнопка57_Click

End Sub

Private Sub Кнопка58_Click()

On Error GoTo Err_Кнопка58_Click

Dim stDocName As String

stDocName = ChrW(1057) & ChrW(1090) & ChrW(1072) & ChrW(1090) & ChrW(1080) & ChrW(1089) & ChrW(1090) & ChrW(1080) & ChrW(1082) & ChrW(1072)

DoCmd.OpenReport stDocName, acNormal

Exit_Кнопка58_Click:

Exit Sub

Err_Кнопка58_Click:

MsgBox Err.Description

Resume Exit_Кнопка58_Click

End Sub

Private Sub Кнопка59_Click()

On Error GoTo Err_Кнопка59_Click

Dim stDocName As String

stDocName = ChrW(1056) & ChrW(1086) & ChrW(1076) & ChrW(1089) & ChrW(1090) & ChrW(1074) & ChrW(1077) & ChrW(1085) & ChrW(1085) & ChrW(1080) & ChrW(1082) & ChrW(1080)

DoCmd.OpenReport stDocName, acNormal

Exit_Кнопка59_Click:

Exit Sub

Err_Кнопка59_Click:

MsgBox Err.Description

Resume Exit_Кнопка59_Click

End Sub

Private Sub Кнопка61_Click()

End Sub

Private Sub Кнопка72_Click()

End Sub