Организация баз данных
|их-| | | |у | | |
|тов| |пос|зак| | |код| | | | | | |
|ара| |тав|азч| | |а | | | | | | |
| | |щик|ика| | | | | | | | | |
| | |а | | | | | | | | | | |
Форма «ГЛАВНАЯ КНОПОЧНАЯ ФОРМА»
[pic]
Option Compare Database
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
Форма «ЗАКАЗЧИК»
[pic]
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
Форма «ПОСТАВЩИК»
[pic]
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
Форма «ТОВАР»
[pic]
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
Форма «О ПРОГРАММЕ»
[pic]
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 = "Для использования формы нужно просматривать или печатать
отчет 'Продажи по годам' из окна базы данных или конструктора."
intStyl
| | скачать работу |
Организация баз данных |