Основы офисного программирования и язык VBA


Пример 2.2


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.

Закрыть окно






Начало  Назад  Вперед



Книжный магазин