Track color change
 

I want to run a procedure when a user changes the background color of a cell.
The worksheet change event is not fired so how can know when the color is
changed?
--
beloni

Track color change
 

On Mar 10, 10:54 am, Nisse wrote:
I want to run a procedure when a user changes the background color of a cell.
The worksheet change event is not fired so how can know when the color is
changed?
--
beloni


Hello,
The only way to detect a color change is to check the worksheet at pre-
determined intervals.
Here is macro that uses the Timer API function to check the cells of
the active worksheet.
Be sure that when you finish running all your code that you Turn Off
the Timer.
Place the procedure you want to call in the TimerProc() sub. Look for
the comment line.

'For Windows 2000 and later
'Timer has a maximum limit of 49.7 days before it rolls over
'Written March 10, 2007
'Author Leith Ross

Public Declare Function SetTimer _
Lib "user32.dll" _
(ByVal hwnd As Long, _
ByVal nIDevent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerfunc As Long) As Long

Public Declare Function KillTimer _
Lib "user32.dll" _
(ByVal hwnd As Long, _
ByVal nIDevent As Long) As Long

Public Declare Function GetTickCount _
Lib "kernel32.dll" _
() As Long


'==========Public Declarations ==============================

Public TimerStartTime As Long

Public TimerID As Long 'Turn On and Off with this ID

Public TimerActive As Boolean 'Is the timer active

'================================================= ===========


Public Sub TurnTimerOn(ByVal MilliSec As Long)

If TimerActive Then Call TurnTimerOff

On Error Resume Next
TimerID = SetTimer(0, 0, MilliSec, AddressOf TimerProc)

TimerActive = True

End Sub

Public Sub TurnTimerOff()

KillTimer 0, TimerID

End Sub

Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal nIDevent
As Long, ByVal dwTime As Long)

'Place timer related code/calls here
Dim Xcolor

Xcolor = ActiveSheet.UsedRange.Interior.ColorIndex

If IsNull(Xcolor) Then
'Name of Procedure to run goes here.
End If

End Sub

Sincerely,
Leith Ross

Track color change
 

Nisse,

Perhaps you can work with the selection_change event and keep track of the
background color changes there.. Something like the code below in the
worksheet code module will pop a message box if the user changes the
background color. It doesn't provide exactly what you're looking for because
in this way, you would only know of the color change AFTER the user makes
another selection. Hope this helps...


Private PrevRange As Range
Private PrevColorIndex As Long

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Target.Address < PrevRange.Address Then
'user has selected a new cell
If PrevRange.Interior.ColorIndex < PrevColorIndex Then
MsgBox "You have changed the background color of " &
PrevRange.Address
End If
Set PrevRange = Target
PrevColorIndex = PrevRange.Interior.ColorIndex
End If
End Sub




"Nisse" wrote:

I want to run a procedure when a user changes the background color of a cell.
The worksheet change event is not fired so how can know when the color is
changed?
--
beloni

Track color change
 

Thank you for your answer.

I tried to implement this but it doesn't seem to work.

I turn timer on in the selection change event.

In TimerProc Xcolor is allways NULL even when I have not changed any color.
I tried if Xcolor would become < NULL when I changed the color in a cell,
but that didn't happen either.
--
beloni


"Leith Ross" wrote:

On Mar 10, 10:54 am, Nisse wrote:
I want to run a procedure when a user changes the background color of a cell.
The worksheet change event is not fired so how can know when the color is
changed?
--
beloni


Hello,
The only way to detect a color change is to check the worksheet at pre-
determined intervals.
Here is macro that uses the Timer API function to check the cells of
the active worksheet.
Be sure that when you finish running all your code that you Turn Off
the Timer.
Place the procedure you want to call in the TimerProc() sub. Look for
the comment line.

'For Windows 2000 and later
'Timer has a maximum limit of 49.7 days before it rolls over
'Written March 10, 2007
'Author Leith Ross

Public Declare Function SetTimer _
Lib "user32.dll" _
(ByVal hwnd As Long, _
ByVal nIDevent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerfunc As Long) As Long

Public Declare Function KillTimer _
Lib "user32.dll" _
(ByVal hwnd As Long, _
ByVal nIDevent As Long) As Long

Public Declare Function GetTickCount _
Lib "kernel32.dll" _
() As Long


'==========Public Declarations ==============================

Public TimerStartTime As Long

Public TimerID As Long 'Turn On and Off with this ID

Public TimerActive As Boolean 'Is the timer active

'================================================= ===========


Public Sub TurnTimerOn(ByVal MilliSec As Long)

If TimerActive Then Call TurnTimerOff

On Error Resume Next
TimerID = SetTimer(0, 0, MilliSec, AddressOf TimerProc)

TimerActive = True

End Sub

Public Sub TurnTimerOff()

KillTimer 0, TimerID

End Sub

Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal nIDevent
As Long, ByVal dwTime As Long)

'Place timer related code/calls here
Dim Xcolor

Xcolor = ActiveSheet.UsedRange.Interior.ColorIndex

If IsNull(Xcolor) Then
'Name of Procedure to run goes here.
End If

End Sub

Sincerely,
Leith Ross