Алексей Гладкий - Excel. Трюки и эффекты

«Внимание!»

Cancel = True

Exit Sub

End If

Next cell

Exit Sub

Err1:

'Обработка ошибок при работе с ячейками

If Err.Number = 1004 Then

MsgBox «Введите корректный адрес ячейки», vbCritical, _

«Ошибка ввода»

Cancel = True

Exit Sub

Else

MsgBox Err.Description, vbCritical, «Ошибка ввода»

Cancel = True

Exit Sub

End If

End Sub

Sub txtResCell_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

' Проверка корректности данных, введенных в поле _

адреса выходной ячейки

Dim rgData As Range

Dim cell As Range

' Проверка, введен ли диапазон данных

If txtRange.Text = "" Then

MsgBox «Введите адрес диапазона суммирования!», _

vbCritical, «Ошибка выполнения»

Cancel = True

End If

If txtResCell.Text = "" Then Exit Sub

On Error GoTo Err1

' Проверка отсутствия циклических ссылок (чтобы одна _

из входных ячеек не была одновременно и выходной)

Set rgData = Range(txtRange.Text)

For Each cell In rgData.Cells

If cell.Address(False, False) = _

Range(txtResCell.Text).Address(False, False) Then

' Нашли циклическую ссылку

MsgBox "Введите другой адрес во избежание " & _

«появления циклических ссылок», vbCritical, _

«Внимание!»

Cancel = True

Exit Sub

End If

Next cell

Exit Sub

Err1:

'Обработка ошибок при работе с ячейками

If Err.Number = 1004 Then

MsgBox «Введите корректный адрес ячейки», vbCritical, _

«Ошибка ввода»

Cancel = True

Exit Sub

Else

MsgBox Err.Description, vbCritical, «Ошибка ввода»

Cancel = True

Exit Sub

End If

End Sub

Sub UserForm_Activate()

' Инициализация формы при активации

Dim intFunc As Integer

Dim strFunc As String

' Заполение списка доступных операций

cboCalcTypes.AddItem "0"

cboCalcTypes.List(0, 1) = «Сумма»

cboCalcTypes.AddItem "1"

cboCalcTypes.List(1, 1) = «Среднее»

cboCalcTypes.AddItem "2"

cboCalcTypes.List(2, 1) = «Максимум»

cboCalcTypes.AddItem "3"

cboCalcTypes.List(3, 1) = «Минимум»

cboCalcTypes.AddItem "4"

cboCalcTypes.List(4, 1) = «Количество ячеек»

cboCalcTypes.AddItem "5"

cboCalcTypes.List(5, 1) = «Сумма положительных»

cboCalcTypes.AddItem "6"

cboCalcTypes.List(6, 1) = «Сумма отрицательных»

cboCalcTypes.AddItem "7"

cboCalcTypes.List(7, 1) = «Количество непустых»

cboCalcTypes.AddItem "8"

cboCalcTypes.List(8, 1) = «Количество непустых ненулевых»

cboCalcTypes.AddItem "9"

cboCalcTypes.List(9, 1) = «Количество положительных»

cboCalcTypes.AddItem «10»

cboCalcTypes.List(10, 1) = «Количество отрицательных»

' Заполнение списка дополнительных цветов

cboOtherColor.AddItem «255»

cboOtherColor.List(0, 1) = «Красный»

cboOtherColor.AddItem «52479»

cboOtherColor.List(1, 1) = «Оранжевый»

cboOtherColor.AddItem «65535»

cboOtherColor.List(2, 1) = «Желтый»

cboOtherColor.AddItem «32768»

cboOtherColor.List(3, 1) = «Зеленый»

cboOtherColor.AddItem «16776960»

cboOtherColor.List(4, 1) = «Голубой»

cboOtherColor.AddItem «16711680»

cboOtherColor.List(5, 1) = «Синий»

cboOtherColor.AddItem «16711935»

cboOtherColor.List(6, 1) = «Фиолетовый»

cboOtherColor.AddItem «16777215»

cboOtherColor.List(7, 1) = «Белый»

cboOtherColor.AddItem "0"

cboOtherColor.List(8, 1) = «Черный»

If Selection.Cells.Count = 1 Then

' На листе есть выделенная ячейка. Определим, есть ли

в этой _

ячейке формула с функцией ColorCalc

intFunc = InStr(Selection.Formula, "ColorCalc(")

If intFunc > 0 Then

' Формула есть, заполним поля формы для вычислений

' Адрес ячейки с результатом

txtResCell.Text = Selection.Address(False, False)

' Выделяем аргументы функции...

' Номера ячеек с исходными данными

strFunc = Mid(Selection.Formula, intFunc + 11)

intFunc = InStr(strFunc, "" "")

txtRange.Text = Left(strFunc, intFunc – 1)

' Тип идентификации ячеек (по шрифту или цвету)

strFunc = Mid(strFunc, intFunc + 2)

intFunc = InStr(strFunc, ",")

strFunc = Mid(strFunc, intFunc + 1)

intFunc = InStr(strFunc, ",")

tglType.Value = Left(strFunc, intFunc – 1)

' Режим вычислений

strFunc = Mid(strFunc, intFunc + 1)

strFunc = Left(strFunc, Len(strFunc) – 1)

intFunc = InStr(strFunc, ",")

cboCalcTypes.Text = cboCalcTypes.List(Val(Left$( _

strFunc, intFunc – 1)), 1)

strFunc = Mid(strFunc, intFunc + 1)

chkVarify.SetFocus

chkVarify.Value = CBool(strFunc)

lblChoose.Visible = True

GetColors

Else

' Будем применять формулу для выделенной ячейки

txtRange.Value = Selection.Address(False, False)

' В выделенной ячейке конкретная функция не задана. _

Выберем первую функцию в списке

cboCalcTypes.Text = «Сумма»

End If

Else

' Будем применять формулу для выделенной ячейки

txtRange.Value = Selection.Address(False, False)

' В выделенной ячейке конкретная функция не задана. _

Выберем первую функцию в списке

cboCalcTypes.Text = «Сумма»

End If

End Sub

Sub GetColors()

' Отображение кнопок выбора цвета окрашенными в цвета, _

встречающиеся среди ячеек заданного диапазона

Dim rgCells As Range

Dim i As Integer

Dim intColorNumber As Integer ' Номер следующей кнопки _

выбора цвета

Dim lngCurColor As Long ' Анализируемый цвет

Dim fColorPresented As Boolean ' Кнопка с цветом _

lngCurColor уже существует

Dim ctrl As Control

Dim strCtrl As String

Dim fBackColor As Boolean ' = True, если ячейки _

идентифицируются по цвету

фона, _

' = False – по цвету шрифта

fBackColor = tglType.Value

On Error Resume Next

' Скрытие всех кнопок выбора цвета

For Each ctrl In Me.Controls

If Left(ctrl.Name, 8) = «cmbColor» Then

ctrl.Visible = False

End If

Next ctrl

On Error GoTo ErrRange

Set rgCells = Range(txtRange.Text)

On Error GoTo 0

' Получение цвета первой ячейки