Excelマクロ・VBA 期限が来たらポップアップ通知する方法
締め切りや消費期限などの日付を記入している場合に、
その日付が来たら自動的に通知してほしい場合があります。
この記事では誰でも使用可能なブックとマクロのコードを紹介します。
目次
サンプルファイル
使用方法
「管理表」と「結果」と「設定」シートがあります。
「結果」と「設定」シートは名前を変えたり削除したりしないでください。
まず「管理表」シートにデータを記入します。
期限の日付を入力する列とシート名は「設定」シートで変更可能です。
次に「設定」シートを調整します。管理表のシート名と期限の列はここで調整してください。
データの開始行数が違う場合や、通知の基準を当日以外にしたい場合もここで調整可能です。
この状態で「設定」シートの「実行」ボタンを押下するか
ファイルを開いた際に期限が来ている行がないかチェックし通知します。
期限の切れている数は赤で表示され空白や文字列など日付でない数は黄色で表示されます。
期限の書いている管理表シートも期限が来ている物は赤の背景色、
日付以外のデータは黄色の背景色になります。
コードと説明
利用するだけであれば先述の手順だけでよいですが
カスタマイズしたい方やマクロの中身を知りたい方向けに
ソースコードの説明は下記のとおりです。
ThisWorkbook
ファイルを開いた際にチェックと通知を行うための部分です。
Option Explicit
Private Sub Workbook_Open()
Call Alert
End Sub標準モジュール
Option Explicit
Sub Alert()
' 設定シート
Dim settingSheet As Worksheet
Set settingSheet = Worksheets("設定")
' 結果シート
Dim resultSheet As Worksheet
Set resultSheet = Worksheets("結果")
' 対象シート
Dim targetSheet As Worksheet
Set targetSheet = Worksheets(settingSheet.Cells(1, 2).Value)
' 対象列
Dim targetColStr As String
targetColStr = settingSheet.Cells(2, 2).Value
' 対象列の最終行を取得
Dim targetColLastRow As Long
targetColLastRow = targetSheet.Cells(Rows.Count, targetColStr).End(xlUp).Row
' 今日の日付を取得
Dim today As Date
today = Date
'データ開始行を取得
Dim dataStartRow As Integer
dataStartRow = settingSheet.Cells(3, 2).Value
Dim i As Integer ' 行数ループカウンタ
Dim v As Variant ' セルからの値受け取り変数
Dim alertCount As Integer ' 期限の過ぎている数
alertCount = 0
Dim checkCount As Integer ' チェック対象の数
checkCount = 0
Dim notDateCount As Integer ' 日付以外の数
notDateCount = 0
' 対象列を全件チェック
For i = 0 To targetColLastRow - dataStartRow
Dim targetCell As Range
Set targetCell = targetSheet.Columns(targetColStr).Rows(dataStartRow + i)
v = targetCell.Value
' データが日付かどうかをチェック
If IsDate(v) Then
' 日付データである
checkCount = checkCount + 1
' 期限が来ているかをチェック
If v + settingSheet.Cells(4, 2).Value <= today Then
' 期限を過ぎている
alertCount = alertCount + 1
targetCell.Font.Color = RGB(255, 255, 255)
targetCell.Interior.Color = RGB(255, 0, 0)
Else
' 期限を過ぎていない
targetCell.Font.Color = RGB(0, 0, 0)
targetCell.Interior.Color = RGB(255, 255, 255)
End If
Else
' 日付データでない場合
notDateCount = notDateCount + 1
targetCell.Font.Color = RGB(0, 0, 0)
targetCell.Interior.Color = RGB(255, 255, 0)
End If
Next
' 結果シートを更新
resultSheet.Cells(1, 2).Value = checkCount
resultSheet.Cells(2, 2).Value = alertCount
resultSheet.Cells(3, 2).Value = notDateCount
' 結果シートに移動
resultSheet.Activate
resultSheet.Cells(1, 1).Select
' チェックのポップアップの表示
If alertCount > 0 Then
MsgBox "期限チェック完了しました。期限切れの項目があります。"
Else
MsgBox "期限チェック完了しました。期限切れの項目はありません。"
End If
End Sub