Private Sub услуга_NotInList(NewData As String, Response As Integer)
    ' Добавляет новый тип при вводе с клавиатуры
    ' в поле со списком «Услуга».
    Dim intNewCategory As Integer, intTruncateName As Integer, strTitle As String, intMsgDialog As Integer
    Dim rs As DAO.Recordset
    ' Выводит окно сообщения с приглашением подтвердить
    ' добавление новой услуги.
       strTitle = "Услуга отсутствует в списке "
    intMsgDialog = vbYesNo + vbQuestion + vbDefaultButton1
    intNewCategory = MsgBox("Добавить новую услугу?", intMsgDialog, strTitle)
If intNewCategory = vbYes Then
        ' Удаляет новое имя из поля «услуга», позволяя выполнить
        ' обновление элемента управления при возвращении в форму.
        DoCmd.RunCommand acCmdUndo
               Set rs = CurrentDb.OpenRecordset("переченьУслуг") ' таблица-источник поляСоСписком
        rs.AddNew
        rs!наименование = NewData
        rs.Update
 ' или если надо добавить более одного поля открывает форму "ДобавлениеУслуги"на таблице переченьУслуг
'        DoCmd.OpenForm "переченьУслуг", acNormal, , , acAdd, acDialog, NewData
'при этом загрузку формы "переченьУслуг" обработать:
'Me.наименование(полеВтаблицеПереченьУслуг)=Me.NewData
        ' Продолжение без вывода стандартного сообщения об ошибке.
        Response = acDataErrAdded
    End If
End Sub

Private Sub категория_Change()
DoCmd.RunCommand acCmdSaveRecord
Me.категория.Requery
End Sub