タイムスタンプを挿入して、時間の経過に合わせて色
Q列に同じ行のA列に文字が入ると、タイムスタンプを挿入して、時間の経過と共に、720時間かけて白から赤にグラデーション変化する。
上記のVBAを行いたいのですが、オーバーフローエラーが発生します。どの様に修正すれば良いでしょうか？
Private Sub Worksheet_Change(ByVal Target As Range)
Dim currentDate As Date
Dim startTime As Date
Dim endTime As Date
If Target.Column <> 1 Or Target.Cells.Count > 1 Then Exit Sub
If Target.Offset(0, 15).Value = "" And Target.Value <> "" Then
startTime = Now()
Target.Offset(0, 15).Value = startTime
ElseIf Target.Offset(0, 15).Value <> "" And Target.Value = "" Then
endTime = Now()
Target.Offset(0, 15).Value = ""
End If
currentDate = Now()
If Target.Offset(0, 15).Value <> "" Then
Target.Offset(0, 16).Interior.Color = GradientColor(Target.Offset(0, 15).Value, currentDate, startTime, 720)
Else
Target.Offset(0, 16).Interior.Color = RGB(255, 255, 255)
End If
End Sub
Function GradientColor(ByVal timeStart As Date, ByVal timeEnd As Date, ByVal startTime As Date, ByVal duration As Integer) As Long
Dim secondsElapsed As Long
Dim fractionTimeElapsed As Double
secondsElapsed = DateDiff("s", startTime, timeEnd)
➡︎ fractionTimeElapsed = secondsElapsed / (duration * 3600)
fractionTimeElapsed = IIf(fractionTimeElapsed > 1, 1, fractionTimeElapsed)
GradientColor = RGB(255 * (1 - fractionTimeElapsed), 255 * fractionTimeElapsed, 255 * fractionTimeElapsed)
End Function
お礼
有難う御座います。