VBA セルを点滅させる方法

• Windows 7
• Excel 2016 32Bit

あらかじめ、どのような条件で点滅させるかの仕様を決めておくことが大切です。

下図は案件ごとに納期を記入し、納期までの日数が３日以内になったらアラート欄が点滅するという仕様です。入力する欄は案件名と納期です。納期欄の入力結果によって残日数を導き出し、その結果によって点滅するかどうかを判断します。つまり、点滅させるかどうかのイベントは納期の記入結果となります。

この仕様をサンプルとして説明します。

構成は下図のように、標準モジュールを追加します。

まずは標準モジュールへ下記のソースを記述します。

Option Explicit

Public NextBlink As Double
Public BlinkingSheet As Worksheet
Public Const COL_DATE As String = "B"
Public Const COL_DAYS As String = "C"
Public Const COL_ALERT As String = "D"

'
' 処理　：点滅
' 引数　：対象セル範囲
'
Public Sub Blinking(ByVal Target As Range)
On Error GoTo SheetSetError
  If BlinkingSheet Is Nothing Then
    Set BlinkingSheet = Worksheets("Blinking")
  End If
  ' 納期列で複数選択でない場合
  If Target.Row >= 4 And Target.Column = 2 And InStr(1, Target.Address, ":") = 0 Then
    ' エラーのない場合
    If (IsError(BlinkingSheet.Range(COL_DAYS & Target.Row).Value) = False) Then
      ' 値のある場合且つ数値の場合
      If BlinkingSheet.Range(COL_DAYS & Target.Row).Value <> "" And IsNumeric(BlinkingSheet.Range(COL_DAYS & Target.Row).Value) Then
        If BlinkingSheet.Range(COL_DAYS & Target.Row).Value <= 3 Then
          StartBlinking COL_ALERT & Target.Row
        Else
          StopBlinking COL_ALERT & Target.Row
        End If
      End If
    Else
      BlinkingSheet.Range(COL_ALERT & Target.Row).Interior.ColorIndex = 0
      BlinkingSheet.Range(COL_ALERT & Target.Row).Value = ""
    End If
  End If
  Exit Sub
SheetSetError:
  MsgBox "Blinkingシートがありません。", vbExclamation, "シート名確認"
End Sub

'
' 処理　：点滅開始
' 引数　：対象セルアドレス
'
Public Sub StartBlinking(ByVal BlinkCell As String)
  'If the color is red, change the color and text to blank
  If BlinkingSheet.Range(BlinkCell).Interior.ColorIndex = 3 Then
    BlinkingSheet.Range(BlinkCell).Interior.ColorIndex = 0
    BlinkingSheet.Range(BlinkCell).Value = ""
    BlinkingSheet.Range(BlinkCell).Font.ColorIndex = 0
  'If the color is white, change the color and text to Warning
  Else
    BlinkingSheet.Range(BlinkCell).Interior.ColorIndex = 3
    BlinkingSheet.Range(BlinkCell).Value = "Warning"
    BlinkingSheet.Range(BlinkCell).Font.ColorIndex = 2
  End If
  'Wait one second before changing the color again
  NextBlink = Now + TimeSerial(0, 0, 1)
  Application.OnTime NextBlink, "'StartBlinking """ & BlinkCell & """'", , True
End Sub

'
' 処理　：点滅終了
' 引数　：対象セルアドレス
'
Public Sub StopBlinking(ByVal BlinkCell As String)
  'Set color to white
  Range(BlinkCell).Interior.ColorIndex = 0
  'Clear the value in the cell
  Range(BlinkCell).ClearContents
  On Error Resume Next
  Application.OnTime NextBlink, "'StartBlinking """ & BlinkCell & """'", , False
  Err.Clear
End Sub

Blinking メソッドの中では、点滅させる条件にマッチしているかをチェックして点滅処理を開始するのか終了するのかを判断しています。もちろん、納期欄の記入結果が正しくない場合や、行追加される場合も考慮しています。ちなみに列追加はNGです。正しく動作しなくなります。

StartBlinking メソッドの中では、該当セルの背景色・文字色の変更と、テキストに"Worning"を表示したり消したりします。TimeSerial 関数を用いてタイマー起動時間を算定し、Application.OnTime を使って StartBlinking を呼び出します。

StopBlinking メソッドの中では、該当セルの設定をクリアし、タイマー処理を停止します。

次に Sheet1 へ下記のソースを記述します。

Option Explicit

'
' 処理　：変更イベント
' 引数　：対象セル範囲
'
Private Sub Worksheet_Change(ByVal Target As Range)
  Blinking Target
End Sub

Workbookへの記述

Option Explicit

'
' 処理　：ブックオープン
'
Private Sub Workbook_Open()
On Error GoTo SheetSetError
  Dim TargetRow As Long
  Dim MaxRow As Long
  ' シートセット
  Set BlinkingSheet = Worksheets("Blinking")
  ' 最終行を取得
  MaxRow = Cells(Rows.Count, 1).End(xlUp).Row
  ' 全行チェック
  For TargetRow = 4 To MaxRow
    Blinking BlinkingSheet.Range(COL_DATE & TargetRow)
    Next
  Exit Sub
SheetSetError:
  MsgBox "Blinkingシートがありません。", vbExclamation, "シート名確認"
End Sub

ブックをオープンした際に、全行に対して点滅する箇所があるかチェックしています。Set BlinkingSheet をしているのは、複数のブックを開いていても影響が出ないようにするためです。

早速、動作検証をしてみましょう。

△△案件の納期を 2018/3/12 に変更してみます。すると・・・、

おおおー、点滅した―＾＾

って静止画じゃよくわからないですよね、すみません。

サンプルを ここ に置いておきますね。

・Blinking.xlsm

・セルを点滅させる

・TimeSerial 関数

・Application.OnTime メソッド (Excel)

VBAでセルの背景色・文字色を変更してセルを点滅させる方法を紹介しました。

いかがでした？セルを点滅させる方法って意外と手間がかかりましたね。

オマケに VBA 側でずっとセルの変更をおこなっているので、そのブックでの「元に戻す(Ctrl + Z)」や、「やりなおし(Ctrl + Y」が使えません。作っておいてなんですが、ユーザーからクレーム出そうで、実務で使うにはちょっとどうかなーって気もしています。

点滅にこだわらなければ「条件付き書式」を使って、セルの背景色を変えたりする方が有効かもしれませんね。