Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Программирование, связанное с MS Office > Функция считает раскрашенные ячейки...

Автор: VovaPHP 3.5.2007, 10:27

Функция считает сколько в диапазоне ячеек опр цвета.
Проблема в том что когда пользователь менят цвет ячейки, то формула не делает перерасчет.
Подскажите, пожалуйста, как это решить?

Код


Function Colors(adr)

Colors = 0

Dim p
For p = 1 To adr.Count
If adr(p).Interior.ColorIndex = 43 Then
Colors = Colors + 1
End If
Next p

End Function

Автор: bilya 4.5.2007, 06:38

Может быть так:

Код


If adr(p).Interior.ColorIndex <> xlNone Then

Автор: VovaPHP 4.5.2007, 19:02

А что это меняет? На всяк случай уточню - это VBA - функция для екселя. Дело в том что функция не срабатывает при изменении цвета. Срабатывает она только если зайти в ячейку.

Автор: pavel55 5.5.2007, 01:33

В Excel нельзя отловить изменение цвета ячейки.

Автор: bilya 5.5.2007, 06:29

Ошибочка вышла - недопонял задачу smile

Если на этот раз правильно понимаю, вам нужно поймать событие изменения цвета ячейки? Если так, то посмотрите это - скидал на событии листа

Код


Dim cVet As Long
Dim adrY

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If cVet <> 0 Then
    If cVet <> ActiveSheet.Range(adrY).Interior.Color Then
        MsgBox "Цвет был изменен"
    End If
End If

cVet = ActiveCell.Interior.Color
adrY = Target.Address

End Sub

Сигнализирует при смене ячейки, если был изменен цвет

Автор: mihanik 15.5.2007, 08:46

Помечу решённым...

Автор: VovaPHP 15.5.2007, 11:06

спасибо была bylia. А как теперь правильно запустить перерасчет?

Автор: mihanik 15.5.2007, 12:01

Модератор: Пожалуйста, один топик - один вопрос.

Автор: bilya 15.5.2007, 14:00

Наверное, убираем

Код


MsgBox "Цвет был изменен"

, а в этом месте вызываем функцию или процедуру делающую перерасчет
smile

Автор: VovaPHP 22.5.2007, 09:35

Все работает. Спасибо bilya

Код


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If cVet <> 0 Then
    If cVet <> ActiveSheet.Range(adrY).Interior.Color Then
        'MsgBox "Цвет был изменен"
        Application.CalculateFull
    End If
End If

cVet = ActiveCell.Interior.Color
adrY = Target.Address

End Sub