[VBA]進捗状況をユーザーに通知する

やりたいこと
- 問題点
- 改善点
イメージ
ソースコード

やりたいこと

とあるツールが複数の機能を持ち合わせているとき、次の弊害が起こりうる。

問題点

機能ごとに分けられたボタンが複数表示されており、どこからクリックしてよいかわからない。
処理が完了するごとに、「完了しました」のメッセージが表示され、OKボタンを押して閉じるのが手間である。
さらに、ユーザーが慣れてきたタイミングで本来はエラーが表示されていたにも関わらず、思考停止でOKを押して、リカバリができなくなってしまう場合がある。
メッセージは一度閉じると確認できなくなってしまうため、ユーザーの注意力がメッセージボックスに割かれる。

改善点

処理結果については、常に画面上に表示されるようにする。
次にどのボタンを押せばよいのか明確にする。
すでに実行したボタンは押せないようにする。

イメージ

VBAからいじるのは、「ボタン」「ステータス」「実行結果」の3点であとは固定のレイアウトである。

ソースコード

実行ボタン管理

Option Explicit

' ----------------------------------------------------------------------------------------------------------------------------------------
' 定数 定義
' ----------------------------------------------------------------------------------------------------------------------------------------
' シート名
Private Const TARGET_SHEET As String = "Main2"

' 色定義
Private Const ENABLED_EXEC_BUTTON_BACKGROUND_COLOR = "#2E75B6"
Private Const ENABLED_EXEC_BUTTON_FONT_COLOR = "#FFFFFF"
Private Const ENABLED_EXEC_BUTTON_LINE_COLOR_COLOR = "#1F4E79"
Private Const DISABLED_EXEC_BUTTON_BACKGROUND_COLOR = "#BFBFBF"
Private Const DISABLED_EXEC_BUTTON_FONT_COLOR = "#F2F2F2"
Private Const DISABLED_EXEC_BUTTON_LINE_COLOR = "#A6A6A6"

' ----------------------------------------------------------------------------------------------------------------------------------------
' 列挙型 定義
' ----------------------------------------------------------------------------------------------------------------------------------------
Public Enum eExecButtonId
    Initialize = 1
    ImportFile = 2
    PADAutomate = 3
    ExportFile = 4
End Enum

' ----------------------------------------------------------------------------------------------------------------------------------------
' Public メソッド
' ----------------------------------------------------------------------------------------------------------------------------------------
' ボタンを有効にする
Public Sub setActive(execButtonId As eExecButtonId)
    Call setActivate(execButtonId, True)
End Sub

' ボタンを無効にする
Public Sub setInactive(execButtonId As eExecButtonId)
    Call setActivate(execButtonId, False)
End Sub

' ----------------------------------------------------------------------------------------------------------------------------------------
' Private メソッド
' ----------------------------------------------------------------------------------------------------------------------------------------
' ボタンを取得する
Private Sub setActivate(execButtonId As eExecButtonId, isActive As Boolean)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(TARGET_SHEET)
    
    Dim buttonName As String
    buttonName = getButtonName(execButtonId)
    Dim macroName As String
    macroName = getMacroName(execButtonId)
    
    Dim shape As shape
    Dim targetShape As shape
    For Each shape In ws.Shapes
        If (buttonName = shape.Name) Then
            Set targetShape = shape
            Exit For
        End If
    Next
    
    If (targetShape Is Nothing) Then
        Call Err.Raise(1025, "", "ボタン名「」が存在しませんでした。")
    End If
    
    With targetShape
        If (isActive = True) Then
            .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = convertColorToRGB(ENABLED_EXEC_BUTTON_FONT_COLOR)
            .Fill.ForeColor.RGB = convertColorToRGB(ENABLED_EXEC_BUTTON_BACKGROUND_COLOR)
            .Line.ForeColor.RGB = convertColorToRGB(ENABLED_EXEC_BUTTON_LINE_COLOR_COLOR)
            .OnAction = macroName
        Else
            .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = convertColorToRGB(DISABLED_EXEC_BUTTON_FONT_COLOR)
            .Fill.ForeColor.RGB = convertColorToRGB(DISABLED_EXEC_BUTTON_BACKGROUND_COLOR)
            .Line.ForeColor.RGB = convertColorToRGB(DISABLED_EXEC_BUTTON_LINE_COLOR)
            .OnAction = "notifyButtonDisabled"
        End If
    End With
End Sub

' ボタン名を取得する
Private Function getButtonName(execButtonId As eExecButtonId) As String
    Dim processName As String
    Select Case execButtonId
        Case eExecButtonId.Initialize
            processName = "Initialize"
        Case eExecButtonId.ImportFile
            processName = "ImportFile"
        Case eExecButtonId.PADAutomate
            processName = "PADAutomate"
        Case eExecButtonId.ExportFile
            processName = "ExportFile"
    End Select
    getButtonName = processName & "Button"
End Function

' ボタン実行時に起動するマクロ名を取得する
Private Function getMacroName(execButtonId As eExecButtonId) As String
    Dim macroName As String
    Select Case execButtonId
        Case eExecButtonId.Initialize
            macroName = "XX01_Initialize"
        Case eExecButtonId.ImportFile
            macroName = "XX02_ImportFile"
        Case eExecButtonId.PADAutomate
            macroName = "XX03_PADAutomate"
        Case eExecButtonId.ExportFile
            macroName = "XX04_ExportFile"
    End Select
    getMacroName = macroName
End Function

' ボタンが非活性であることを通知する
Private Sub notifyButtonDisabled()
    Call MsgBox("前処理が完了していないため、このボタンは現在押すことができません。")
End Sub

' 文字色をRGB形式に変換する
Private Function convertColorToRGB(color As String) As Long
    Dim r As Long
    Dim g As Long
    Dim b As Long
    r = Val("&H" & Mid(color, 2, 2))
    g = Val("&H" & Mid(color, 4, 2))
    b = Val("&H" & Mid(color, 6, 2))
    convertColorToRGB = RGB(r, g, b)
End Function

ステータス表示


Option Explicit

' ----------------------------------------------------------------------------------------------------------------------------------------
' 定数 定義
' ----------------------------------------------------------------------------------------------------------------------------------------
' 座標定義
Private Const TARGET_SHEET As String = "Main2"
Private Const PROGRESS_BEGIN_ROW As Long = 7
Private Const STEP_STATUS_COLUMN As Long = 8
Private Const EXECUTE_MESSAGE_COLUMN As Long = 9

' セマンティックカラー
Private Const COLOR_SUCCESS = "#197A4B"
Private Const COLOR_ERROR = "#CE0000"
Private Const COLOR_WARNING = "#FB5B01"
' ----------------------------------------------------------------------------------------------------------------------------------------
' 列挙型 定義
' ----------------------------------------------------------------------------------------------------------------------------------------
Public Enum eStepId
    Step1 = 1
    Step2 = 2
    Step3 = 3
    Step4 = 4
    Step5 = 5
    Step6 = 6
End Enum

Public Enum eStepStatus
    NotStarted      ' 未実行
    Success           ' 完了
    AnyError         ' エラー
    InProgress      ' 実行中
End Enum

' ----------------------------------------------------------------------------------------------------------------------------------------
' Public メソッド
' ----------------------------------------------------------------------------------------------------------------------------------------
' ステータスを更新する
Public Sub updateStepStatus(stepId As eStepId, stepStatus As eStepStatus, executeMessage As String)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(TARGET_SHEET)

    Dim stepStatusDisplayName As String
    Dim displayColor As Long
        Select Case stepStatus
        Case eStepStatus.NotStarted
            stepStatusDisplayName = "ー"
            displayColor = convertColorToRGB("#A6A6A6")
        Case eStepStatus.Success
            stepStatusDisplayName = "完了"
            displayColor = convertColorToRGB(COLOR_SUCCESS)
        Case eStepStatus.AnyError
            stepStatusDisplayName = "エラー"
            displayColor = convertColorToRGB(COLOR_ERROR)
        Case eStepStatus.InProgress
            stepStatusDisplayName = "実行中"
            displayColor = convertColorToRGB("#F9D57B")
    End Select
    
    Dim stepStatusCell As Range
    Set stepStatusCell = ws.Cells( _
        PROGRESS_BEGIN_ROW + stepId - 1, _
        STEP_STATUS_COLUMN)
    Dim executeMessageCell As Range
    Set executeMessageCell = ws.Cells( _
        PROGRESS_BEGIN_ROW + stepId - 1, _
        EXECUTE_MESSAGE_COLUMN)
    
    stepStatusCell.value = stepStatusDisplayName
    stepStatusCell.Font.color = displayColor
    executeMessageCell.value = executeMessage
    executeMessageCell.Font.color = displayColor
End Sub

' ----------------------------------------------------------------------------------------------------------------------------------------
' Private メソッド
' ----------------------------------------------------------------------------------------------------------------------------------------
' 文字色をRGB形式に変換する
Private Function convertColorToRGB(color As String) As Long
    Dim r As Long
    Dim g As Long
    Dim b As Long
    r = Val("&H" & Mid(color, 2, 2))
    g = Val("&H" & Mid(color, 4, 2))
    b = Val("&H" & Mid(color, 6, 2))
    convertColorToRGB = RGB(r, g, b)
End Function

ソースコード着目点

デメリット

ボタン押下時に呼びだすメソッド名については、文字列で指定しているのがちょっと気持ち悪い。

当然VBAでは、リフレクションでgetMethodName(method)みたいなことはできない。

メリット

実行ボタンと実行結果の出力を分けることで、実行ボタンの単位 ≠実行結果の出力とすることができる（イメージ図の通り）

えんすく！

まったりプログラミング