If Values(i) > varOut Then varOut = Values(i)
Case dhcMin
' Нахождение минимального значения
If i = LBound(Values) Then varOut = Values(i)
If Values(i) < varOut Then varOut = Values(i)
Case dhcCount
' Подсчет количества значений
varOut = varOut + 1
Case dhcCountFull
' Подсчет количества заполненных ячеек
If Not IsEmpty(Values(i)) Then varOut = varOut + 1
Case dhcCountNotNull
' Подсчет количества пустых ячеек
If Not IsEmpty(Values(i)) And Values(i) <> 0 Then _
varOut = varOut + 1
Case dhcCountPlus
' Подсчет количества положительных значений
If Values(i) > 0 Then varOut = varOut + 1
Case dhcCountMinus
' Подсчет количества отрицательных значений
If Values(i) < 0 Then varOut = varOut + 1
End Select
Next i
' Окончательные операции для некоторых видов расчета
If intMode = dhcAvg Then
' Вычисление среднего значения
ColorCalc = varOut / intCount
Else
ColorCalc = varOut
End If
End Function
В приведенном выше коде реализованы следующие элементы:
• функция ColorCalc – выполняет все расчеты с использованием цвета (параметры этой функции и ее аргументы рассматриваются в следующем разделе);
• макрос CalcColors – отображает форму управления расчетом (см. ниже).
В проект VBA необходимо также добавить форму и поместить в ее модуль код, приведенный в листинге 5.6.
Dim lngCurColor As Long ' Выбранный цвет, по которому _
идентифицировать (отбирать) ячейки
Dim intMode As Integer ' Номер типа вычисления в списке
Sub cmbApplyColor_Click()
If cboOtherColor.Value >= 0 Then
' Вычисление с использованием выбранного в списке цвета
lngCurColor = cboOtherColor.Value
SetColorSum
End If
End Sub
Sub cmbColor1_Click()
' Вычисление с использованием цвета нажатой кнопки
lngCurColor = cmbColor1.BackColor
SetColorSum
End Sub
Sub cmbColor2_Click()
' Вычисление с использованием цвета нажатой кнопки
lngCurColor = cmbColor2.BackColor
SetColorSum
End Sub
Sub cmbColor3_Click()
' Вычисление с использованием цвета нажатой кнопки
lngCurColor = cmbColor3.BackColor
SetColorSum
End Sub
Sub cmbColor4_Click()
' Вычисление с использованием цвета нажатой кнопки
lngCurColor = cmbColor4.BackColor
SetColorSum
End Sub
Sub cmbColor5_Click()
' Вычисление с использованием цвета нажатой кнопки
lngCurColor = cmbColor5.BackColor
SetColorSum
End Sub
Sub cmbColor6_Click()
' Вычисление с использованием цвета нажатой кнопки
lngCurColor = cmbColor6.BackColor
SetColorSum
End Sub
Sub cmbColor7_Click()
' Вычисление с использованием цвета нажатой кнопки
lngCurColor = cmbColor7.BackColor
SetColorSum
End Sub
Sub cmbColor8_Click()
' Вычисление с использованием цвета нажатой кнопки
lngCurColor = cmbColor8.BackColor
SetColorSum
End Sub
Sub cmbColor9_Click()
' Вычисление с использованием цвета нажатой кнопки
lngCurColor = cmbColor9.BackColor
SetColorSum
End Sub
Sub cmbColor10_Click()
' Вычисление с использованием цвета нажатой кнопки
lngCurColor = cmbColor10.BackColor
SetColorSum
End Sub
Sub cmbColor11_Click()
' Вычисление с использованием цвета нажатой кнопки
lngCurColor = cmbColor11.BackColor
SetColorSum
End Sub
Sub cmbColor12_Click()
' Вычисление с использованием цвета нажатой кнопки
lngCurColor = cmbColor12.BackColor