Выборочный обмен данными между n-
|
Option Explicit Private Sub CommandButton1_Click() 'Обработчик события Click кнопки "> <" ' Выборочный обмен данными между n- колоночными списками: 'ListBox1 <--> ListBox2 If CommandButton1.Caption = ">" Then Call MoveSelectedItems(ListBox1.ColumnCount, ListBox1, ListBox2) Else Call MoveSelectedItems(ListBox2.ColumnCount, ListBox2, ListBox1) End If End Sub Private Sub CommandButton2_Click() 'Обработчик события Click кнопки ">> <<" 'Перенос всех данных из одного n-колоночного списка 'в конец другого, возможно, не пустого списка: ListBox1 <--> ListBox2 If CommandButton2.Caption = ">>" Then Call MoveAllItems(ListBox1.ColumnCount, ListBox1, ListBox2) Else Call MoveAllItems(ListBox2.ColumnCount, ListBox2, ListBox1) End If End Sub Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 'Обработчик события DblClick левого списка ListBox1 (имеет параметры!) 'При двойном щелчке выбранный элемент одного n-колоночного списка 'переносится в конец другого списка Call MoveSelectedItems(ListBox1.ColumnCount, ListBox1, ListBox2) End Sub Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 'Обработчик события DblClick правого списка ListBox2 'При двойном щелчке выбранный элемент одного n-колоночного списка 'переносится в конец другого списка Call MoveSelectedItems(ListBox2.ColumnCount, ListBox2, ListBox1) End Sub Private Sub CommandButton5_Click() 'Обработчик события Click кнопки "OK" 'Перенос данных из списка на лист Excel 'В область, заданную ячейкой с именем "Dom" Call MoveListToRange(ListBox2.ColumnCount, ListBox2, "Dom") Me.Hide End Sub Private Sub CommandButton6_Click() 'Обработчик события Click кнопки "Cancel" Me.Hide End Sub Private Sub ListBox1_Enter() 'Обработчик события Enter, возникающего при получении фокуса CommandButton1.Caption = ">" CommandButton2.Caption = ">>" End Sub Private Sub ListBox2_Enter() 'Обработчик события Enter, возникающего при получении фокуса CommandButton1.Caption = "<" CommandButton2.Caption = "<<" End Sub Private Sub UserForm_Initialize() 'Обработчик события Initialize формы TwoListsForm 'Заполнение списка ListBox1 Dim MyArray(1 To 5, 1 To 2) As String MyArray(1, 1) = "Петров" : MyArray(1, 2) = "Музыкант" MyArray(2, 1) = "Сергеев" : MyArray(2, 2) = "Учитель" MyArray(3, 1) = "Гурина" : MyArray(3, 2) = "Актриса" MyArray(4, 1) = "Водкин" : MyArray(4, 2) = "Художник" MyArray(5, 1) = "Козина" : MyArray(5, 2) = "Геолог" ListBox1.ColumnCount = 2 : ListBox2.ColumnCount = 2 ListBox1.List() = MyArray End Sub |
| Пример 2.1. |
| Закрыть окно |
|
Option Explicit Public Sub MoveSelectedItems(ByVal n As Byte, ByVal ListBox1 As Object, _ ByVal ListBox2 As Object) 'Перемещает выделенные элементы первого списка в конец второго 'с одновременным удалением данных из первого списка. 'Оба списка имеют n столбцов. Dim RowIndex1 As Byte, RowIndex2 As Byte, i As Byte, j As Byte 'Выборочный обмен данными между списками: ListBox1 -> ListBox2 With ListBox1 RowIndex2 = ListBox2.ListCount RowIndex1 = 0 For i = 0 To .ListCount - 1 If .Selected(RowIndex1) Then 'Создается элемент нового списка и заполняется его первый столбец ListBox2.AddItem .List(RowIndex1) 'Заполняются остальные столбцы элемента списка For j = 1 To n - 1 ListBox2.Column(j, RowIndex2) = .Column(j, RowIndex1) Next j 'Перемещенный элемент удаляется из списка .RemoveItem RowIndex1 RowIndex2 = RowIndex2 + 1 Else RowIndex1 = RowIndex1 + 1 End If Next i End With End Sub Public Sub MoveAllItems(ByVal n As Byte, ByVal ListBox1 As Object, _ ByVal ListBox2 As Object) ' Перемещает все элементы первого списка в конец второго, ' возможно, не пустого списка с одновременным удалением данных из ' первого списка. ListBox1 -> ListBox2 Dim RowIndex1 As Integer, RowIndex2 As Integer, i As Byte RowIndex2 = ListBox2.ListCount For RowIndex1 = 0 To ListBox1.ListCount - 1 With ListBox1 ListBox2.AddItem .List(0) For i = 1 To n - 1 ListBox2.Column(i, RowIndex2) = .Column(i, 0) Next i RowIndex2 = RowIndex2 + 1 'Перемещенный,- это всегда первый элемент,удаляется из списка .RemoveItem 0 End With Next RowIndex1 End Sub Public Sub MoveListToRange(ByVal n As Byte, List1 As Object, Dom As String) 'List1 - объект типа ListBox, состоящий из n столбцов. ' Его элементы переносятся в прямоугольную область активного листа, ' Dom - задает имя ячейки, расположенной в левом верхнем углу этой ' области. Dim myr As Range Dim i As Byte, j As Byte Set myr = Range(Dom) 'Цикл по числу элементов списка. For i = 0 To List1.ListCount - 1 'Цикл по числу столбцов списка. For j = 0 To n - 1 myr.Offset(j, i) = List1.Column(j, i) Next j Next i End Sub Public Sub ClearRange(Dom As String) 'Эта процедура очищает содержимое области листа рабочей книги, 'заданной ячейкой с именем Dom Dim myr As Range, Row As Byte, Col As Byte Set myr = Range(Dom) Col = 0: Row = 0 While myr.Offset(Row, Col) <> "" While myr.Offset(Row, Col) <> "" 'Чистка содержимого myr.Offset(Row, Col).ClearContents Col = Col + 1 Wend Row = Row + 1 Col = 0 Wend End Sub |
| Пример 2.2. |
| Закрыть окно |
|
Private Sub CommandButton5_Click() ChooseBook End Sub Public Sub ChooseBook() 'Выбор книги, с которой будет работать пользователь Const PathDir As String = "e:\O2000\CD2000\Ch2\" Dim Answer As Variant Dim CurrentBook As String Dim Book As Workbook Dim Found As Boolean Answer = InputBox(prompt:= _ "Выберите книгу, с которой будете работать (1/2/3)", Default:=1) Select Case Answer Case 1 CurrentBook = "BookOne.xls" Case 2 CurrentBook = "BookTwo.xls" Case 3 CurrentBook = "BookThree.xls" Case Else CurrentBook = "I don't know such book" End Select MsgBox ("Your choose is " & CurrentBook) 'Проверяем есть ли уже книга в коллекции Found = False For Each Book In Workbooks If Book.Name = CurrentBook Then Found = True Exit For End If Next Book If Found Then 'Активизируем выбранную книгу Workbooks(CurrentBook).Activate ElseIf CurrentBook = "I don't know such book" Then MsgBox ("I don't know such book") Else 'Добавляем книгу в коллекцию Workbooks.Open PathDir & CurrentBook Workbooks(CurrentBook).Activate End If End Sub |
| Пример 2.3. |
| Закрыть окно |
|
Private Sub CommandButton1_Click() BookOne.Sheet1.ChooseBook End Sub Public Sub ChangeGlobal() ' Изменение значений глобальных переменных системы документов BookOne.ModuleOne.Two = "My value is Two " TwoThree = "My value is Two - Two " End Sub Public Sub PrintGlobal() Dim Number As Integer Debug.Print ("Работает процедура PrintTwo") Debug.Print ("Печать глобальных переменных") Debug.Print TwoThree 'Вызов процедур и функций проекта BookOne Number = BookOne.ModuleOne.PLus1(1) Debug.Print ("Это книга " & Number) ChangeGlobal BookOne.ModuleOne.PrintGlobal End Sub |
| Пример 2.4. |
| Закрыть окно |
