New-B02

Option Explicit

'*******************************************************
'    【Main】シートに作業開始時間を記入する関数
'    ・指定セルに「作業中 hh:mm:ss ～」と記入
'    ・セル背景色を淡い黄色に変更
'*******************************************************
Public Function InputStt(strRng As String)
    Application.ScreenUpdating = True               '画面描画再開
    ThisWorkbook.Activate

    With ThisWorkbook.Worksheets("Main")
        .Select
        With .Range(strRng)
            .Select
            .Interior.Color = RGB(255, 255, 102)   '淡い黄色
            .Value = "作業中 " & Format(Time, "hh:mm:ss") & " ～"
        End With
    End With

    Call WaitOneSecond
End Function

'*******************************************************
'    【Main】シートに作業終了時間を記入する関数
'    ・指定セルに「終了日時」を記入（yyyy/mm/dd hh:mm）
'    ・背景色を無色に戻す
'    ・2列右に「処理時間（h:mm:ss）」を記入
'*******************************************************
Public Function InputEnd(strRng As String, exeTime As Date)
    Application.ScreenUpdating = True                  '画面描画再開
    ThisWorkbook.Activate

    With ThisWorkbook.Worksheets("Main")
        .Select
        With .Range(strRng)
            .Value = Format(Now, "yyyy/mm/dd hh:mm")   '終了日時
            .Interior.Color = xlNone                   '背景色を無色に
            .Select
            .Offset(0, 2).Value = Format(exeTime, "h:mm:ss")   '処理時間
        End With
    End With

    Call WaitOneSecond
End Function

'*******************************************************
'    【Main】シートにエラー発生時間と状態を記入する関数
'    ・指定セルに「エラー発生日時」を記入（yyyy/mm/dd hh:mm）
'    ・背景色を淡いピンクに変更
'    ・2列右に「エラー終了」の文字列を記入
'*******************************************************
Public Function InputErr(strRng As String, exeTime As Date)
    Application.ScreenUpdating = True                  '画面描画再開
    ThisWorkbook.Activate

    With ThisWorkbook.Worksheets("Main")
        .Select
        With .Range(strRng)
            .Value = Format(Now, "yyyy/mm/dd hh:mm")   'エラー発生日時
            .Interior.Color = rgbLightPink             '背景色：淡いピンク
            .Select
            .Offset(0, 2).Value = "エラー終了"         '状態記入
        End With
    End With

    Call WaitOneSecond
End Function

'===================================================================================

'*******************************************************
'    任意のシートに作業開始時間を記入する関数
'    ・指定セルに「[処理名] 中 hh:mm:ss ～」と記入
'    ・セル背景色を淡い黄色に変更
'*******************************************************
Public Function InputSttSht(shtName As String, strRng As String, _
                            myProcd As String)
    Application.ScreenUpdating = True               '画面描画再開
    ThisWorkbook.Activate

    With ThisWorkbook.Worksheets(shtName)
        .Select
        With .Range(strRng)
            .Select
            .Interior.Color = RGB(255, 255, 102)    '淡い黄色
            .Value = myProcd & " 中 " & Format(Time, "hh:mm:ss") & " ～"
        End With
    End With

    Call WaitOneSecond
End Function

'*******************************************************
'    ■ 任意シートに作業終了情報を記入する関数
'    ・指定セルに「プロシージャ名＋完了＋日時＋実行時間」を記入
'    ・背景色を淡いグレー（GhostWhite）に変更
'*******************************************************
Public Function InputEndSht(shtName As String, strRng As String, _
                            myProcd As String, exeTime As Date)

    Application.ScreenUpdating = True              '画面描画再開
    ThisWorkbook.Activate

    With ThisWorkbook.Worksheets(shtName)
        .Select
        With .Range(strRng)
            .Value = myProcd & "完了" & vbCrLf & _
                     Format(Now, "yyyy/mm/dd hh:mm") & _
                     "   実行時間 " & Format(exeTime, "h:mm:ss")
            .Interior.Color = rgbGhostWhite       '背景色：淡いグレー
            .Select
        End With
    End With

    Call WaitOneSecond
End Function

'*******************************************************
'    ■ エラー終了メッセージを記入（終了時点）
'    ・指定セルに「エラー終了＋プロシージャ名」を記入
'    ・背景色を赤に変更
'*******************************************************
Public Function InputErrShtEnd(shtName As String, strRng As String, _
                               myProcd As String, exeTime As Date)

    Application.ScreenUpdating = True             '画面描画再開
    ThisWorkbook.Activate

    With ThisWorkbook.Worksheets(shtName)
        .Select
        With .Range(strRng)
            .Value = "エラー終了 " & myProcd & vbCrLf & _
                     Format(Now, "yyyy/mm/dd hh:mm") & _
                     "   実行時間 " & Format(exeTime, "h:mm:ss")
            .Interior.Color = rgbTomato               '背景色：赤系
            .Select
        End With
    End With

    Call WaitOneSecond
End Function

'*******************************************************
'    ■ エラー発生メッセージを記入（開始時点）
'    ・指定セルに「プロシージャ名＋エラー終了」を記入
'    ・背景色を淡いピンクに変更
'*******************************************************
Public Function InputErrSht(shtName As String, strRng As String, _
                            myProcd As String)

    Application.ScreenUpdating = True             '画面描画再開
    ThisWorkbook.Activate

    With ThisWorkbook.Worksheets(shtName)
        .Select
        With .Range(strRng)
            .Value = myProcd & " エラー終了"
            .Interior.Color = rgbLightPink        '背景色：淡いピンク
            .Select
        End With
    End With

    Call WaitOneSecond
End Function
'*******************************************************
'    ■ メッセージレンジにメッセージを入力する関数
'    ・指定セルに任意メッセージを記入
'    ・背景色を淡いピンクに変更
'*******************************************************
Public Function InputMsg(shtName As String, strRng As String, _
                         myMsg As String)

    Application.ScreenUpdating = True             '画面描画再開
    ThisWorkbook.Activate

    With ThisWorkbook.Worksheets(shtName)
        .Select
        With .Range(strRng)
            .Value = myMsg
            .Interior.Color = rgbLightPink        '背景色：淡いピンク
            .Select
        End With
    End With

    Call WaitOneSecond
End Function

'*******************************************************
'    ■ メッセージレンジを空白に戻す関数
'    ・指定セルの内容を消去
'    ・背景色を無色に戻す
'*******************************************************
Public Function InputResume(shtName As String, strRng As String)

    Application.ScreenUpdating = True             '画面描画再開
    ThisWorkbook.Activate

    With ThisWorkbook.Worksheets(shtName)
        .Select
        With .Range(strRng)
            .Value = ""
            .Interior.Color = xlNone              '背景色：無色
            .Select
        End With
    End With

    Call WaitOneSecond
End Function