.Enabled = False
.Locked = True
' .SetFocus
' .OnEnter = "=Вход_ПолеСоСписком()"
' .OnExit = "=Выход_ПолеСоСписком()"
End With
End If
ElseIf Dostup = 2 Then
With ctl
.Enabled = True
.Locked = False
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
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![Кнопочная форма]")
' MsgBox Error$
Resume Close_Form_Exit
End Function
Function Exit_Main()
DoCmd.Quit acSave
Function IsForm(NameForm As String) As Integer
' Возвращает True, если актиным окном является форма.
On Error Resume Next
If Err Then
IsForm = False
If strFormName = NameForm Then
IsForm = True
On Error GoTo 0
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)
EditN_Err:
MsgBox Err.Description
Function EditD() As Integer
On Error GoTo EditD_Err
' frm.AllowEdits = True
varTmp = EnableControls("Detail", True, False)
EditD_Err:
Function EnableControls(strWhichSection As String, intState As Integer, intLocked As Integer) As Integer
' Включает и отключает элементы управления в указанных разделах формы.
Dim ctl As Control
Dim intX As Integer, intSelectedSection As Integer
' Использует активную форму. Если активной формы нет,
' осуществляет выход из формы без вывода сообщения об ошибке.
EnableControls = False
' Определяет допустимые значения аргумента 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"
End Select
' Присваивает значение аргумента intState, intLocked всем
' элементам управления в указанном разделе.
For intX = 0 To frm.Count - 1
Set ctl = frm(intX)
If ctl.Section = intSelectedSection Then
ctl.Enabled = intState
ctl.Locked = intLocked
Next intX
EnableControls = True
' К_полю_поиска
Function К_полю_поиска()
On Error GoTo К_полю_поиска_Err
Dim Fr As Form
Set Fr = Screen.ActiveForm
Fr![ПолеПоиска].SetFocus
SendKeys "{F4}", False
К_полю_поиска_Exit:
К_полю_поиска_Err:
Resume К_полю_поиска_Exit
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
Function Печать_отчета(stDocName As String)
On Error GoTo Err_Печать_отчета
Dim stDocName1 As String
'stDocName = "Z_Abon_КолПоУлицам"
stDocName1 = stDocName
DoCmd.OpenReport stDocName1, acNormal
Exit_Печать_отчета:
Err_Печать_отчета:
Resume Exit_Печать_отчета
'В данном примере функция IsNull проверяет, имеет ли элемент
'управления пустое (Null) значение.
'Если да, выводится приглашение ввести данные.
'Если элемент управления имеет присвоенное значение,
'выводится сообщение с этим значением.
Sub ControlValue(ctlText As Control)
' Проверяет, что элемент управления является полем.
If ctlText.ControlType = acTextBox Then
' При значении Null выводит приглашение ввести данные.
If IsNull(ctlText.Value) Then
strMsg = "Пустое поле '" & _
ctlText.Name & "'." & strCRLF & _
"Введите значение данного поля."
If MsgBox(strMsg, vbQuestion) = vbOK Then
' Если поле имеет непустое значение, выводит это значение.
MsgBox (ctlText.Value)
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
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 ' Выход из функции при обнаружении формы.
Next
' Команды_УдЗап
Function Команды_УдЗап()
On Error GoTo Команды_УдЗап_Err
DoCmd.DoMenuItem 0, 1, 7, 0, acMenuVer70 ' Форма, Правка, Удалить запись
Команды_УдЗап_Exit:
Команды_УдЗап_Err:
Resume Команды_УдЗап_Exit
' Команды_Обновить
Function Команды_Обновить()
On Error GoTo Команды_Обновить_Err
DoCmd.Requery ""
Команды_Обновить_Exit:
Команды_Обновить_Err:
Resume Команды_Обновить_Exit
' Команды_ДобавитьЗап
Function Команды_ДобавитьЗап()
On Error GoTo Команды_ДобавитьЗап_Err
DoCmd.DoMenuItem 0, 3, 0, 0, acMenuVer70 ' Форма, Вставка, Запись
Команды_ДобавитьЗап_Exit:
Команды_ДобавитьЗап_Err:
Resume Команды_ДобавитьЗап_Exit
Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15
