28090-1 (Организация баз данных), страница 4

Option Explicit

Private Sub Form_Open(Cancel As Integer)

' Свертывание окна базы данных, инициализация формы.

' Переход на страницу кнопочной формы, отмеченную для использования по умолчанию.

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

Me.FilterOn = True

End Sub

Private Sub Form_Current()

' Обновление заголовка и заполнение списка команд.

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

FillOptions

End Sub

Private Sub FillOptions()

' Заполнение команд для страницы кнопочной формы.

' Число кнопок в форме.

Const conNumButtons = 8

Dim dbs As Database

Dim rst As Recordset

Dim strSQL As String

Dim intOption As Integer

' Установка фокуса на первую кнопку формы, скрытие всех кнопок формы, кроме первой.

' Поле с фокусом скрыть нельзя.

Me![Option1].SetFocus

For intOption = 2 To conNumButtons

Me("Option" & intOption).Visible = False

Me("OptionLabel" & intOption).Visible = False

Next intOption

' Открытие таб. элементов кнопочной формы, поиск первого элемента текущей страницы формы.

Set dbs = CurrentDb()

strSQL = "SELECT * FROM [Элементы кнопочной формы]"

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

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

Set rst = dbs.OpenRecordset(strSQL)

' Вывод сообщения при отсутствии элементов на странице кнопочной формы.

' В остальных случаях - заполнение страницы элементами.

If (rst.EOF) Then

Me![OptionLabel1].Caption = "Элементы кнопочной формы отсутствуют"

Else

While (Not (rst.EOF))

Me("Option" & rst![ItemNumber]).Visible = True

Me("OptionLabel" & rst![ItemNumber]).Visible = True

Me("OptionLabel" & rst![ItemNumber]).Caption = rst![ItemText]

rst.MoveNext

Wend

End If

' Закрытие набора записей и базы данных.

rst.Close

dbs.Close

End Sub

Private Function HandleButtonClick(intBtn As Integer)

' Эта функ. вызывается при нажатии кнопки. Аргумент intBtn указывает, какая кнопка была нажата.

' Константы для выполняемых команд.

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 conErrDoCmdCancelled = 2501

Dim dbs As Database

Dim rst As Recordset

On Error GoTo HandleButtonClick_Err

' Поиск записи, соответствующей нажатой кнопке, в таблице элементов кнопочной формы.

Set dbs = CurrentDb()

Set rst = dbs.OpenRecordset("Элементы кнопочной формы", dbOpenDynaset)

rst.FindFirst "[SwitchboardID]=" & Me![SwitchboardID] & " AND [ItemNumber]=" & intBtn

' Если нужная запись не найдена, вывод сообщения об ошибке и выход из функции.

If (rst.NoMatch) Then

MsgBox "Ошибка при чтении таблицы элементов кнопочной формы."

rst.Close

dbs.Close

Exit Function

End If

Select Case rst![Command]

' Переход к другой кнопочной форме.

Case conCmdGotoSwitchboard

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

' Открытие формы в режиме добавления записей.

Case conCmdOpenFormAdd

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

' Открытие формы.

Case conCmdOpenFormBrowse

DoCmd.OpenForm rst![Argument]

' Открытие отчета.

Case conCmdOpenReport

DoCmd.OpenReport rst![Argument], acPreview

' Настройка кнопочной формы.

Case conCmdCustomizeSwitchboard

' Обработка ситуации, когда диспетчер

' кнопочных форм не установлен

' (например, при сокращенной установке).

On Error Resume Next

Application.Run "WZMAIN80.sbm_Entry"

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

On Error GoTo 0

' Обновление формы.

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

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

FillOptions

' Выход из приложения.

Case conCmdExitApplication

CloseCurrentDatabase

' Запуск макроса.

Case conCmdRunMacro

DoCmd.RunMacro rst![Argument]

' Выполнение программы.

Case conCmdRunCode

Application.Run rst![Argument]

' Другие команды не поддерживаются.

Case Else

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

End Select

' Закрытие набора записей и базы данных.

rst.Close

dbs.Close

HandleButtonClick_Exit:

Exit Function

HandleButtonClick_Err:

' Если выполнение прервано пользователем, сообщение об ошибке не выводится.

' Вместо этого выполнение продолжается со следующей строки.

If (Err = conErrDoCmdCancelled) Then

Resume Next

Else

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

Resume HandleButtonClick_Exit

End If

End Function

Форма «ЗАКАЗЧИК»

Option Compare Database

Option Explicit

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

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

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70

DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70

Exit_Кнопка18_Click:

Exit Sub

Err_Кнопка18_Click:

MsgBox Err.Description

Resume Exit_Кнопка18_Click

End Sub

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

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

Dim stDocName As String

stDocName = "Запрос2"

DoCmd.OpenReport stDocName, acPreview

Exit_Кнопка20_Click:

Exit Sub

Err_Кнопка20_Click:

MsgBox Err.Description

Resume Exit_Кнопка20_Click

End Sub

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

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

Dim stDocName As String

Dim stLinkCriteria As String

stDocName = "Товары"

DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_Кнопка33_Click:

Exit Sub

Err_Кнопка33_Click:

MsgBox Err.Description

Resume Exit_Кнопка33_Click

End Sub

Sub ПолеСоСписком34_AfterUpdate()

' Поиск записи, соответствующей этому элементу управления.

Me.RecordsetClone.FindFirst "[Name_zakaz] = '" & Me![ПолеСоСписком34] & "'"

Me.Bookmark = Me.RecordsetClone.Bookmark

End Sub

Форма «ПОСТАВЩИК»

Option Compare Database

Option Explicit

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

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

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70

DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70

Exit_Кнопка18_Click:

Exit Sub

Err_Кнопка18_Click:

MsgBox Err.Description

Resume Exit_Кнопка18_Click

End Sub

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

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

Dim stDocName As String

stDocName = "Запрос1"

DoCmd.OpenReport stDocName, acPreview

Exit_Кнопка20_Click:

Exit Sub

Err_Кнопка20_Click:

MsgBox Err.Description

Resume Exit_Кнопка20_Click

End Sub

Форма «ТОВАР»

Option Compare Database

Option Explicit

Sub ПолеСоСписком18_AfterUpdate()

' Поиск записи, соответствующей этому элементу управления.

Me.RecordsetClone.FindFirst "[Name_tovar] = '" & Me![ПолеСоСписком18] & "'"

Me.Bookmark = Me.RecordsetClone.Bookmark

End Sub

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

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

DoCmd.Close

Exit_Кнопка25_Click:

Exit Sub

Err_Кнопка25_Click:

MsgBox Err.Description

Resume Exit_Кнопка25_Click

End Sub

Форма «О ПРОГРАММЕ»

Option Compare Database ' Сортировка базы данных для сравнения строк.

Option Explicit ' Обязательное описание переменных перед применением.

Private Sub Отмена_Click()

' Программа, созданная мастером кнопок.

On Error GoTo Err_Cancel_Click

' Закрытие формы.

DoCmd.Close

Exit_Cancel_Click:

Exit Sub

Err_Cancel_Click:

MsgBox Err.Description

Resume Exit_Cancel_Click

End Sub

Private Sub ОК_Click()

On Error GoTo Err_OK_Click

Dim strMsg As String, strTitle As String

Dim intStyle As Integer

' Если отчет о продажах по годам не был открыт для просмотра или печати, возникает ошибка.

' (Перем. blnOpening имеет значение True, только если для отчета произошло событие Open.)

If Not Reports![Дата].blnOpening Then Err.Raise 0

' Скрытие формы.

Me.Visible = False

Exit_OK_Click:

Exit Sub

Err_OK_Click:

strMsg = "Для использования формы нужно просматривать или печатать отчет 'Продажи по годам' из окна базы данных или конструктора."

intStyle = vbOKOnly

strTitle = "Открытие из отчета"

MsgBox strMsg, intStyle, strTitle

Resume Exit_OK_Click

End Sub

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

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

DoCmd.Close

Exit_Кнопка5_Click:

Exit Sub

Err_Кнопка5_Click:

MsgBox Err.Description

Resume Exit_Кнопка5_Click

End Sub

Форма «ПОДЧИНЁННАЯ ФОРМА ТОВАРА»

Option Compare Database

Option Explicit

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

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

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70

DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70

Exit_Кнопка22_Click:

Exit Sub

Err_Кнопка22_Click:

MsgBox Err.Description

Resume Exit_Кнопка22_Click

End Sub

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

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

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70

DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70

Exit_Кнопка23_Click:

Exit Sub

Err_Кнопка23_Click:

MsgBox Err.Description

Resume Exit_Кнопка23_Click

End Sub

ЗАПРОС1

SELECT Товары.Name_tovar, Sum(Товары.Cena) AS Sum_Cena, Поставщик.Name_postav, Поставщик.Number_D, Поставщик.Date_Z

FROM Поставщик INNER JOIN Товары ON Поставщик.Key_postav = Товары.Key_tovar

WHERE (((Поставщик.Name_postav)=[Forms]![Поставщик]![Name_postav]))

GROUP BY Товары.Name_tovar, Поставщик.Name_postav, Поставщик.Number_D, Поставщик.Date_Z;

ЗАПРОС2

SELECT Заказчик.Name_zakaz, Заказчик.Adres_zakaz, Заказчик.Number_N, Заказчик.Date_N, Товары.Name_tovar, Товары.Srok_god, Товары.Ves_b, Товары.Ves_n, Товары.Cena, Товары.Date

FROM [Заказчик] INNER JOIN Товары ON Заказчик.Name_tov = Товары.Name_tovar

WHERE (((Заказчик.Name_tov)=[Forms]![Заказчик1]![Name_tov]))

GROUP BY Заказчик.Name_zakaz, Заказчик.Adres_zakaz, Заказчик.Number_N, Заказчик.Date_N, Товары.Name_tovar, Товары.Srok_god, Товары.Ves_b, Товары.Ves_n, Товары.Cena, Товары.Date;