SetColorSum
End Sub
Sub SetColorSum()
' Вычисление с использованием заданного цвета
Dim strFormula As String
' Проверка правильности введенных диапазонов и номеров ячеек
If txtResCell.Value = "" Then
MsgBox «Введите адрес ячейки вставки функции», _
vbCritical, «Внимание!»
txtResCell.SetFocus
Exit Sub
ElseIf txtRange.Value = "" Then
MsgBox «Введите адрес диапазона суммирования», _
vbCritical, «Внимание!»
txtRange.SetFocus
Exit Sub
End If
' Формирование формулы
strFormula = "=ColorCalc(" & """"& txtRange.Value & """" _
& "," & lngCurColor & "," & CInt(tglType.Value) & "," _
& intMode & "," & CInt(chkVarify.Value) & ")"
' Запись формулы в ячейку
Range(txtResCell.Value).Formula = strFormula
End Sub
Sub cmbExit_Click()
' Закрытие формы
Unload Me
End Sub
Sub cboCalcTypes_AfterUpdate()
' Изменение режима вычисления – сохраним в переменной _
номер вычисления
intMode = cboCalcTypes.ListIndex
End Sub
Sub cboOtherColor_Change()
' Изменение выделенного цвета в списке «Другой»
If cboOtherColor.Text <> "" Then
' Сохранение выбранного цвета в переменной
lngCurColor = Val(cboOtherColor.Value)
End If
End Sub
Sub tglType_Click()
' Изменение типа идентификации ячеек
If tglType.Value = -1 Then
' Идентификация по цвету заливки
tglType.Caption = «Заливка»
Else
' Идентификация по цвету шрифта
tglType.Caption = «Шрифт»
End If
GetColors
End Sub
Sub txtRange_AfterUpdate()
' Изменение диапазона с исходными данными – покажем _
кнопки с цветами, представленными в новом диапазоне
GetColors
End Sub
Sub txtRange_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 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)