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

関連記事

マクロ・VBA 最初のプログラム

フォローする