VBA セルを点滅させる方法 ホームページ制作 | 墨田区

VBA セルを点滅させる方法

LINEで送る
Pocket

VBAでセルを点滅させる方法です。
VBAでセルを点滅させる方法

セルを点滅させるには Application.OnTime を使います。Application.OnTime はタイマー処理で、指定した時刻にマクロを起動することができます。
タイマー処理を使って、1秒毎にで背景色・文字色を変更する処理を動作させると、点滅表示することができます。もちろん1秒にこだわる必要はなく、3秒でも5秒でも OK です。

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




【PR】マジか?!「アレ」してるLINEスタンプっていったい・・・


環境

・Windows 7
・Excel 2016 32Bit

VBAでセルを点滅させる

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

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

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

構成は下図のように、標準モジュールを追加します。
VBAでセルを点滅させるために標準モジュールを追加

標準モジュールへの記述

まずは標準モジュールへ下記のソースを記述します。
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 を呼び出します。

文法説明
TimeSerial(hour,minute,second)引数で指定した時分秒の時刻を返します。
Application.OnTime(EarliestTime, Procedure, LatestTime, Schedule)指定された時刻(特定の日時、または特定の期間の経過後)にプロシージャを実行します。

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

Sheet1への記述

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

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

変更イベントで点滅処理を呼び出します。

Workbookへの記述

最後に 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 に変更してみます。すると・・・、
VBAでセルを点滅させる条件VBAでセルを点滅させる条件と手段

おおおー、点滅した―^^
VBAでセルを点滅させた

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

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

参考サイト

セルを点滅させる
TimeSerial 関数
Application.OnTime メソッド (Excel)

まとめ

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

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

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

おつかれさまでした。

LINEで送る
Pocket

この記事がお役に立ちましたら シェア をお願いいたします。

コメントを残す

コメント(必須)

お名前 (必須)
メールアドレス
(アドレスは公開されません)

Trackback URL