MS Access 2007 VBA - Код кода многократного использования

Question

У меня есть приложение MS Access 2007, которое имеет несколько форм, где я использовал один и тот же дизайн списка. У меня есть два списка, один из которых GetS значения из таблицы с помощью запроса, как:

SELECT id, value FROM table 

И второй, который изначально пуст. Между этими двумя списками расположены кнопки добавления и удаления, которые по умолчанию отключены. Щелчок по значению в первом списке позволяет добавить кнопку, а при щелчке по значению во втором списке появляется кнопка удаления. Нажатие кнопки добавления добавляет выбранный элемент во второй список, а нажатие кнопки удаления удаляет элемент для второго списка.

код у меня есть для кнопки добавления следующим образом («ALLLIST» относится к списку значений запроса, «SELECTEDLIST» является тот, который изначально пуст):

Dim selectedId, selectedValue, safeValue As String 
Dim existing As Boolean 
Dim index As Integer 

existing = False 
selectedId = Me.ALLLIST.Value 
index = Me.ALLLIST.ListIndex 
selectedValue = Me.ALLLIST.Column(1,index) 

'Loop through the list of selected values and see if this one has already been added to the list 
For i = 0 To (Me.SELECTEDLIST.ListCount) 
    If (Me.SELECTEDLIST.Column(0, i) = selectedId) Then 
     existing = True 
    End If 
Next i 

'Only add the value if it's not already on the list 
If (existing) Then 
    MsgBox "This list can't contain duplicate values", vbOKOnly + vbInformation, "Error" 
Else 
    safeValue = Replace(selectedValue & "", "'", "''") 
    Me.SELECTEDLIST.AddItem (selectedId & ";'" & safeValue & "'") 
    Me.SELECTEDLIST.Value = Null 
    Me.REMOVEBUTTON.Enabled = False 
End If 

И код кнопка Удалить:

Dim numItems, index As Integer 
index = Me.SELECTEDLIST.ListIndex 

'Remove the selected item and move to the top of the list 
Me.SELECTEDLIST.RemoveItem (index) 
Me.SELECTEDLIST.Selected(0) = True 

numItems = Me.SELECTEDLIST.ListCount 

'Cosmetic feature, select the row above the one we're removing 
If (index > 0) Then 
    Me.SELECTEDLIST.Selected(index - 1) = True 
Else 
    Me.SELECTEDLIST.Selected(0) = True 
End If 

'If the list is empty now, disable the remove button 
If (numItems = 0) Then 
    Me.ALLLIST.SetFocus 
    Me.REMOVEBUTTON.Enabled = False 
    Me.SELECTEDLIST.Selected(-1) = True 
End If 

то, что я хотел бы сделать это, а не копировать и вставить этот код повсюду, имеют этот шаблон хранится где-то, а затем в моей форме кода написать что-то вроде:

hookUpLists(allListName, selectedListName, addButtonName, removeButtonName) 

Как это сделать? Могу ли я написать модуль, чтобы сделать это как? Я также открыт для любых улучшений, которые я могу сделать по вышеуказанному коду.

Благодарности

Answer 1

Спасибо за подсказку об использовании модулей класса, HK1, я никогда не использовал их раньше.

Чтобы решить оригинальный вопрос, я создал новый модуль класса «MultiSelectListBox», который имеет следующий код:

Option Compare Database 

    Private WithEvents allList As ListBox 
    Private WithEvents selectedList As ListBox 
    Private WithEvents addBtn As CommandButton 
    Private WithEvents removeBtn As CommandButton 
    Private numColumns As Integer 

    Public Sub hookUpLists(numberOfColumns As Integer, allValuesList As ListBox, selectedValuesList As ListBox, addButton As CommandButton, _ 
         removeButton As CommandButton) 

    'Grab all the controls passed in 
    Set allList = allValuesList 
    Set selectedList = selectedValuesList 
    Set addBtn = addButton 
    Set removeBtn = removeButton 
    numColumns = numberOfColumns 

    'Tell Access we want to handle the click events for the controls here 
    allList.OnClick = "[Event Procedure]" 
    selectedList.OnClick = "[Event Procedure]" 
    addBtn.OnClick = "[Event Procedure]" 
    removeBtn.OnClick = "[Event Procedure]" 

    End Sub 

    Private Sub allList_Click() 
    addBtn.Enabled = True 
    End Sub 

    Private Sub selectedList_Click() 
    removeBtn.Enabled = True 
    End Sub 

    Private Sub addBtn_Click() 
    Dim selectedId As String 
    Dim existing As Boolean 
    Dim index As Integer 

    existing = False 
    selectedId = allList.Value 
    index = allList.ListIndex 

    'Loop through the list of selected values and see if this one has already been added to the list 
    For i = 0 To (selectedList.ListCount) 
     If (selectedList.Column(0, i) = selectedId) Then 
      existing = True 
     End If 
    Next i 

    'Only add the value if it's not already on the list 
    If (existing) Then 
     MsgBox "This list can't contain duplicate values", vbOKOnly + vbInformation, "Error" 
     Exit Sub 
    End If 

    Dim item As String 
    item = selectedId & ";" 

    'Loop over all of the columns and add them to the second list box 
    For i = 1 To numColumns - 1 
     item = item & "'" & Replace(allList.Column(i, index) & "", "'", "''") & "'" 

     'Don't add a trailing semicolon 
     If (i <> numColumns - 1) Then 
      item = item & ";" 
     End If 
    Next i 

    selectedList.AddItem (item) 
    selectedList.Value = Null 
    removeBtn.Enabled = False 

    'Select the next row 
    If (index <> allList.ListCount - 1) Then 
     allList.Selected(index + 1) = True 
     allList.Value = allList.Column(0, index + 1) 
    End If 

    End Sub 

    Private Sub removeBtn_Click() 
    Dim numItems, index As Integer 
    index = selectedList.ListIndex 

    'Remove the selected item and move to the top of the list 
    selectedList.RemoveItem (index) 
    selectedList.Selected(0) = True 

    numItems = selectedList.ListCount 

    'Cosmetic feature, select the row above the one we're removing 
    If (index > 0) Then 
     selectedList.Selected(index - 1) = True 
    Else 
     selectedList.Selected(0) = True 
    End If 

    'If the list is empty now, disable the remove button 
    If (numItems = 0) Then 
     allList.SetFocus 
     removeBtn.Enabled = False 
     selectedList.Selected(-1) = True 
    End If 
End Sub 

Большинство из вышеперечисленного идентичен тому, что я уже использовал, одна важная вещь, примечание для тех, кто спотыкается об этом, - это использование «WithEvents» при объявлении переменных. Это говорит Access для просмотра в модуле класса для обработчиков событий. Наконец, из моей формы я могу сделать следующее:

Private contactList As MultiSelectListBox 

Private Sub Form_Open(Cancel As Integer) 
    Set contactList = New MultiSelectListBox 
    contactList.hookUpLists 3, Me.allContactsList, Me.selectedContactsList, Me.addContactBtn, Me.removeContactBtn 
End Sub