Основы офисного программирования и язык 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




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