×
Traktatov.net » Excel. Трюки и эффекты » Читать онлайн
Страница 137 из 146 Настройки

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;