M
Marc
Guest
Bonjour le forum,
Je fais appel à vous encore et encore car je ne m'en sort pas. Je deviens fou.
Qui veut bien me dire ou je commet une (ou des) erreur dans ce code :
Option Explicit
Public OrigBkgCol As Long, OrigTxtCol As Long
Public OldCell As Range
Declare Sub Sleep Lib 'kernel32' (ByVal dwMilliseconds As Long)
Sub LookingForRedCell()
Dim FirstCell As Range
Dim Cell As Range
Dim Plage As Range
Dim i As Byte
For Each Cell In Range('B7:H183')
If Cell = Range('B1') Then
Set FirstCell = Cell
Exit For
End If
Next
If FirstCell Is Nothing Then
MsgBox 'Date ' & Range('B1') & ' non trouvée, procédure avortée', vbCritical
Exit Sub
End If
Set Plage = Range(FirstCell.Offset(1, 0), ActiveCell.Offset(98, 0))
'Moi j'ai juste mis un truc pour que ça clignotte dix fois (Rouge/Jaune/Rouge)
'pour attirer l'attention puis le code te laisse la main...
For Each Cell In Plage
If Cell.Interior.ColorIndex = 3 Then
Cell.Activate
For i = 1 To 10
Sleep (100)
Set OldCell = ActiveCell
Sleep (100000)
OrigBkgCol = ActiveCell.Interior.ColorIndex = 3
Sleep (100000)
OrigTxtCol = ActiveCell.Font.ColorIndex = 6
Application.OnTime Now + TimeValue('00:00:01'), 'Flash'
'Cell.Interior.ColorIndex = 3 'rouge
'Sleep (100)
'Cell.Interior.ColorIndex = 6 'jaune
Next i
Exit For
End If
Next
End Sub
En vous en remerciant très chaleureusement - Marc
Je fais appel à vous encore et encore car je ne m'en sort pas. Je deviens fou.
Qui veut bien me dire ou je commet une (ou des) erreur dans ce code :
Option Explicit
Public OrigBkgCol As Long, OrigTxtCol As Long
Public OldCell As Range
Declare Sub Sleep Lib 'kernel32' (ByVal dwMilliseconds As Long)
Sub LookingForRedCell()
Dim FirstCell As Range
Dim Cell As Range
Dim Plage As Range
Dim i As Byte
For Each Cell In Range('B7:H183')
If Cell = Range('B1') Then
Set FirstCell = Cell
Exit For
End If
Next
If FirstCell Is Nothing Then
MsgBox 'Date ' & Range('B1') & ' non trouvée, procédure avortée', vbCritical
Exit Sub
End If
Set Plage = Range(FirstCell.Offset(1, 0), ActiveCell.Offset(98, 0))
'Moi j'ai juste mis un truc pour que ça clignotte dix fois (Rouge/Jaune/Rouge)
'pour attirer l'attention puis le code te laisse la main...
For Each Cell In Plage
If Cell.Interior.ColorIndex = 3 Then
Cell.Activate
For i = 1 To 10
Sleep (100)
Set OldCell = ActiveCell
Sleep (100000)
OrigBkgCol = ActiveCell.Interior.ColorIndex = 3
Sleep (100000)
OrigTxtCol = ActiveCell.Font.ColorIndex = 6
Application.OnTime Now + TimeValue('00:00:01'), 'Flash'
'Cell.Interior.ColorIndex = 3 'rouge
'Sleep (100)
'Cell.Interior.ColorIndex = 6 'jaune
Next i
Exit For
End If
Next
End Sub
En vous en remerciant très chaleureusement - Marc