Excelマクロ・VBA 期限が来たらポップアップ通知する方法

2020年5月6日

締め切りや消費期限などの日付を記入している場合に、

その日付が来たら自動的に通知してほしい場合があります。

この記事では誰でも使用可能なブックとマクロのコードを紹介します。

サンプルファイル

使用方法

「管理表」と「結果」と「設定」シートがあります。

「結果」と「設定」シートは名前を変えたり削除したりしないでください。

まず「管理表」シートにデータを記入します。

期限の日付を入力する列とシート名は「設定」シートで変更可能です。

「管理表」シートのサンプル

次に「設定」シートを調整します。管理表のシート名と期限の列はここで調整してください。

データの開始行数が違う場合や、通知の基準を当日以外にしたい場合もここで調整可能です。

「設定」シートのキャプチャ

この状態で「設定」シートの「実行」ボタンを押下するか

ファイルを開いた際に期限が来ている行がないかチェックし通知します。

期限の切れている数は赤で表示され空白や文字列など日付でない数は黄色で表示されます。

チェックのポップアップと結果シートのキャプチャ

期限の書いている管理表シートも期限が来ている物は赤の背景色、

日付以外のデータは黄色の背景色になります。

管理表シートのチェック結果のキャプチャ

コードと説明

利用するだけであれば先述の手順だけでよいですが

カスタマイズしたい方やマクロの中身を知りたい方向けに

ソースコードの説明は下記のとおりです。

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

関連記事

マクロ・VBAの学習・活用方法の記事一覧

期限が近付いたら通知してくれるリマインダーを作成する方法