NotInList: Добавление значения в справочную таблицу

При разработке баз данных довольно часто используются справочные таблицы для подстановки набора значений. В случае если эта таблица имеет одно поле для добавления нового значения через событие NotInList списка можно использовать данную функцию.

Выполните следующие шаги:

1.	Поместите функцию в доступный модуль.

2.	В свойство списка Row Source поместить SQL запрос на получение данных из требуемой таблицы

3.	Выставте значение свойства списка LimitToList в Yes

4.	В обработке события NotInList поместите Response = AppendLookupTable(Me![MyCombo], NewData)

Public Function AppendLookupTable(cbo As ComboBox, NewData As Variant, Optional blnMsg As Boolean = True) As Integer
Dim rst As DAO.Recordset
Dim Response As Long
On Error GoTo m1

AppendLookupTable = acDataErrContinue
If Not (IsNull(NewData)) Then
    If blnMsg Then
        Response = MsgBox("Значение [" & NewData & "] отсутствует в списке." & vbCrLf & "Для добавления нажмите ОК.", vbOKCancel + vbQuestion, "Добавление значения")
    Else
        Response = 1
    End If
    Select Case Response
      Case 1
      Set rst = CurrentDb.OpenRecordset(cbo.RowSource)
        rst.AddNew
        rst(0) = NewData
        rst.Update
        rst.Close
        AppendLookupTable = acDataErrAdded
      Case 2
        Exit Function
    End Select
End If
m2:
Set rst = Nothing
Exit Function
m1:
MsgBox "Ошибка " & Err.Number & ": " & Err.Description, vbInformation, " в функции AppendLookupTable"
Resume m2
End Function

Удаление данных из списка

Public Function DeleteLookupTable(cbo As ComboBox, Optional blnMsg As Boolean = True)
Dim rst As DAO.Recordset
Dim Response As Long
On Error GoTo m1

If Not (IsNull(cbo)) Then
    If blnMsg Then
        Response = MsgBox("Удалить значение [" & cbo & "] из списка?" & vbCrLf & "Для удаления нажмите ОК.", vbOKCancel + vbQuestion, "Удаление значения")
    Else
        Response = 1
    End If
    Select Case Response
      Case 1
        Set rst = CurrentDb.OpenRecordset(cbo.RowSource, dbOpenDynaset)
        rst.FindFirst rst(0).Name & "='" & cbo & "'"
        rst.Delete
        rst.Close
        cbo = Null
        cbo.Requery
      Case 2
        Exit Function
    End Select
End If
m2:
Set rst = Nothing
Exit Function
m1:
MsgBox "Ошибка " & Err.Number & ": " & Err.Description, vbInformation, " в функции DeleteLookupTable"
Resume m2
End Function

Ссылки по теме