![]() Главная страница Случайная страница КАТЕГОРИИ: АвтомобилиАстрономияБиологияГеографияДом и садДругие языкиДругоеИнформатикаИсторияКультураЛитератураЛогикаМатематикаМедицинаМеталлургияМеханикаОбразованиеОхрана трудаПедагогикаПолитикаПравоПсихологияРелигияРиторикаСоциологияСпортСтроительствоТехнологияТуризмФизикаФилософияФинансыХимияЧерчениеЭкологияЭкономикаЭлектроника |
Получение информации о выделенном диапазоне
Листинг 2.41. Получение информации о выделенном диапазоне Sub TypeOfSelection() Dim rgSelUnion As Range ' Объединение выделенных областей Dim strTitle As String ' Заголовок сообщения Dim strMessage As String ' Текст сообщения Dim strSelType As String ' Тип выделения (простой или _ множественный) Dim intBlockCount As Integer ' Количество блоков в выделении Dim intCellCount As Long ' Общее количество выделенных ячеек Dim intColCount As Integer ' Количество выделенных столбцов Dim intRowCount As Long ' Количество выделенных строк Dim intAreasCount As Integer ' Количество выделенных областей Dim strCurSelType As String Dim rgArea As Range
' Подсчет количества выделенных областей и определение типа выделения: _ простое (одна область) или сложное(несколько областей) intAreasCount = Selection.Areas.Count If intAreasCount = 1 Then strTitle = " Простое выделение" Else strTitle = " Множественное выделение" End If
' Определение типа выделения первой области strSelType = dhGetAreaType(Selection.Areas(1))
' Создание объединения во избежание повторного учета _ пересекающихся участков выделенных диапазонов Set rgSelUnion = Selection.Areas(1) For Each rgArea In Selection.Areas strCurSelType = dhGetAreaType(rgArea) ' Изменение надписи о типе всего выделения, если _ есть выделения различного типа If strCurSelType < > strSelType Then strSelType = " Множественный" End If
' Определение количества блоков перед их добавлением в объединение If strCurSelType = " Block" Then intBlockCount = intBlockCount + 1 End If ' Добавление в объединение Set rgSelUnion = Union(rgSelUnion, rgArea) Next rgArea
' Просматриваются элементы созданного объединения For Each rgArea In rgSelUnion.Areas Select Case dhGetAreaType(rgArea) Case " Строка" intRowCount = intRowCount + rgArea.Rows.Count Case " Столбец" intColCount = intColCount + rgArea.Columns.Count Case " Лист" intColCount = intColCount + rgArea.Columns.Count intRowCount = intRowCount + rgArea.Rows.Count End Select Next rgArea ' Определение количества неперекрывающихся ячеек intCellCount = rgSelUnion.Count
' Формирование и вывод итогового сообщения strMessage = " Тип выделения: " & vbTab & strSelType & vbCrLf & _ " Количество областей: " & vbTab & intAreasCount & vbCrLf & _ " Полных столбцов: " & vbTab & intColCount & vbCrLf & _ " Полных строк: " & vbTab & intRowCount & vbCrLf & _ " Блоков ячеек: " & vbTab & intBlockCount & vbCrLf & _ " Всего ячеек: " & vbTab & Format(intCellCount, " #, ###") MsgBox strMessage, vbInformation, strTitle End Sub
Function dhGetAreaType(rgRangeArea As Range) As String ' Определение типа диапазона If rgRangeArea.Count = Cells.Count Then ' Все ячейки рабочего листа dhGetAreaType = " Лист" ElseIf rgRangeArea.Cells.Count = 1 Then ' Одна ячейка dhGetAreaType = " Ячейка" ElseIf rgRangeArea.Rows.Count = Cells.Rows.Count Then ' Весь столбец dhGetAreaType = " Столбец" ElseIf rgRangeArea.Columns.Count = Cells.Columns.Count Then ' Вся строка dhGetAreaType = " Строка" Else ' Блок ячеек dhGetAreaType = " Блок" End If End Function
|