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
' Получение цвета первой ячейки
If fBackColor = False Then
lngCurColor = rgCells.Cells(i).Font.Color
Else
lngCurColor = rgCells.Cells(i).Interior.Color
End If
' Назначения цвета первой ячейки первой кнопке
cmbColor1.BackColor = lngCurColor
cmbColor1.Visible = True
' Просмотр остальных ячеек и при нахождении новых цветов _
отображение кнопок, окрашенных в эти цвета
intColorNumber = 2
For i = 2 To rgCells.Cells.Count
fColorPresented = False
' Получение цвета i-й ячейки
If fBackColor = False Then
lngCurColor = rgCells.Cells(i).Font.Color
Else
lngCurColor = rgCells.Cells(i).Interior.Color
End If
' Проверка, отображается ли уже кнопка с таким цветом
For Each ctrl In Me.Controls
If Left(ctrl.Name, 8) = «cmbColor» And _
ctrl.Visible = True Then
If lngCurColor = ctrl.BackColor Then
' Кнопка с цветом i-й ячейки уже отображается
fColorPresented = True
Exit For
End If
End If
Next ctrl
If Not fColorPresented Then
' Кнопки с цветом lngCurColor еще нет – покажем ее
intColorNumber = intColorNumber + 1
strCtrl = «cmbColor» & intColorNumber
Me.Controls(strCtrl).BackColor = lngCurColor
Me.Controls(strCtrl).Visible = True
End If
Next i
Exit Sub
ErrRange:
' Обработка ошибок при работе с диапазоном
If txtRange.Text = "" Then
MsgBox «Введите адрес диапазона суммирования», _
vbCritical, «Внимание!»
Else
MsgBox «Введен некорректный адрес диапазона суммирования», _
vbCritical, «Ошибка!»
End If
' Установка курсора в поле ввода диапазона
txtRange.SetFocus
End Sub
После помещения кода, представленного в листинге 5.6, в модуль формы необходимо сформировать ее внешний вид, как показано на рис. 5.10.
Рис. 5.10. Пользовательская форма
При работе с формой необходимо выполнить следующие действия (для присвоения значений свойствам используется панель VBA Properties (Свойства)):
• форме присвоить имя f rmColorCalc;