(495) 925-0049, ITShop интернет-магазин 229-0436, Учебный Центр 925-0049
  Главная страница Карта сайта Контакты
Поиск
Вход
Регистрация
Рассылки сайта
 
 
 
 
 

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

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


 Распечатать »
 Правила публикации »
  Написать редактору 
 Рекомендовать » Дата публикации: 12.12.2007 
 

Магазин программного обеспечения   WWW.ITSHOP.RU
Microsoft 365 Business Basic (corporate)
Microsoft Office 365 Персональный 32-bit/x64. 1 ПК/MAC + 1 Планшет + 1 Телефон. Все языки. Подписка на 1 год.
Microsoft 365 Business Standard (corporate)
Microsoft Office 365 для Дома 32-bit/x64. 5 ПК/Mac + 5 Планшетов + 5 Телефонов. Подписка на 1 год.
Microsoft Office для дома и учебы 2019 (лицензия ESD)
 
Другие предложения...
 
Курсы обучения   WWW.ITSHOP.RU
 
Другие предложения...
 
Магазин сертификационных экзаменов   WWW.ITSHOP.RU
 
Другие предложения...
 
3D Принтеры | 3D Печать   WWW.ITSHOP.RU
 
Другие предложения...
 
Новости по теме
 
Рассылки Subscribe.ru
Информационные технологии: CASE, RAD, ERP, OLAP
Безопасность компьютерных сетей и защита информации
Новости ITShop.ru - ПО, книги, документация, курсы обучения
Программирование на Microsoft Access
CASE-технологии
Новые материалы
Компьютерная библиотека: книги, статьи, полезные ссылки
 
Статьи по теме
 
Новинки каталога Download
 
Исходники
 
Документация
 
 



    
rambler's top100 Rambler's Top100