VisualBasic(Date型の基準値の違いによる時刻の問題)

勤務表などの時刻をExcelに表現させる時に苦労します。

23:59:59を超える時刻がExcelのセルにセットできない   この問題に当たって、Excelのセルに時刻をセットするのに「文字列」で処理されているなどという方もいるかも知れません。旧VBで言うところの「日付(Date)型」と、.NET(VB2005/2008)の「日付(Date)型」では、内部処理が全く違っていて、日付表記の転記についてはある程度は「救済」されるようなのですが、時刻で23:59:59を超える値については特に問題があります。
「基準値」の違いはこのようなことです。
----------------------------------------------------------------------
・旧VB(VBA,VB6.0等)：西暦100年1月1日～西暦9999年12月31日
   (1899年12月30日より前の日付はマイナス値)
・新VB(VB2005/2008等)：西暦0001年1月1日から西暦9999年12月31日までの日付と、
   午前12:00:00から午後11:59:59.9999999までの時刻
   既定値は0001年1月1日の0:00:00(午前0時)
----------------------------------------------------------------------
今回の問題は、VB2005/2008上の処理からExcelワークシート上に日付を含まない「時刻」をセットする場合の問題ですが、上記の「基準値」の違いが起因して23:59:59を超える時刻をセルに転記する時に例外が発生してしまいます。
解決させるキーワードは「693593」でした。

Excelのセルに時刻を入力する場合．．．．

Excelでセルに時刻の書式を「[h]:mm」のようにセットしておいて時刻を入力する場合、 24時を過ぎる時刻を入力しても当然問題はないのです。
ExcelVBAからでも、


'*******************************************************************************
'   24:30分をセルにセットする
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'*******************************************************************************
Option Explicit

'*******************************************************************************
'   24:30分をセルにセットする
'*******************************************************************************
Sub TEST_2430()
    Cells(2, 4).Value = TimeSerial(24, 30, 0)
End Sub

'--------------------------------<< End of Source >>----------------------------

このようにTimeSerial関数等を用いて24時を過ぎる時刻を入力しても特に問題はなく動作します。

確認ですがExcelのセル上での「時刻」の捕らわれ方を見てみます。

※セルの書式は「[h]:mm」としてありますので、秒の部分は表示されませんが24時を超えてもそのまま時間表示されます。

例えば「18:30」の時刻をセルに入力した場合は、

このように表示され、数式バーには「18:30:00」と表示されます。

同様に「23:59:59」の時刻をセルに入力した場合は、

このように表示され、数式バーには「23:59:59」と表示されます。

ですが「24:30」の時刻をセルに入力した場合は、

このようにセル上は「24:30」と表示され、数式バーには「1900/1/1 0:30:00」と表示されます。
これは、「23:59:59」までは１日の中の時刻として表現されますが、「23:59:59」を超えてしまうと「日数＋時刻」といった表現に変わってしまうわけです。この時の「日数」にあたる「日付」の表意がExcelVBAや旧VBと.NET(VB2005/2008)で動作が異なるというのが今回の問題です。

今回のケースでは最初からソースコードを見て進めてみます。

動作メニューは次の４種類にしてみました。

①TimeSerial関数で18:30:00をそのままセット
②TimeSerial関数で24:30:00をそのままセット ⇒エラーになります。
③TimeSerial関数で18:30:00を｢日付型差分加算｣してセット
④TimeSerial関数で24:30:00を｢日付型差分加算｣してセット

これらの処理を行なうソースコードです。


'***************************************************************************************************
' Excelへの時刻データ貼り付けテスト(起動フォーム)
'
' ※Excelワークシートへの時刻データの貼り付けが問題なく行なわれるか試してみます。
'   試してみるのは下記の４種類の方法です。(対象はD2セル)
'   ・①TimeSerial関数で18:30:00をそのままセット
'   ・②TimeSerial関数で24:30:00をそのままセット
'   ・③TimeSerial関数で18:30:00を｢日付型差分加算｣してセット
'   ・④TimeSerial関数で24:30:00を｢日付型差分加算｣してセット
' ※Excelは参照設定となっています。
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
' 変更日付 Rev   変更履歴内容---------------------------------------------------------------------->
' 09/06/21(1.0.0.0)新規作成
' 17/04/22(1.0.1.0)記述統制見直し、Excel関連クラス統合作業
'***************************************************************************************************
Imports System.IO
Imports Microsoft.Office.Interop
Public Class dlgExcelKidou
    '===============================================================================================
    Private Const g_cnsTitle As String = "Excelへの時刻データ貼り付けテスト"
    '-----------------------------------------------------------------------------------------------
    Private Const g_cnsTempPath As String = "..\..\ExcelTemplate"
    Private Const g_cnsTemplate As String = "13_KINMUHYOU1.xltx"
    Private ReadOnly g_tblSYORI_MODE() As String = {"", "①", "②", "③", "④"}
    '-----------------------------------------------------------------------------------------------
    ' 新旧日付型の基準値の差分値
    Private ReadOnly g_cnsAddTimeforCell As TimeSpan = New TimeSpan(693593, 0, 0, 0)

    '***********************************************************************************************
    ' ■■■ フォーム上のコントロールイベント ■■■
    '***********************************************************************************************
    '* 処理名　：Button1_Click
    '* 機能　　：ボタン①クリックイベント
    '-----------------------------------------------------------------------------------------------
    '* 返り値　：(なし)
    '* 引数　　：(既定)
    '-----------------------------------------------------------------------------------------------
    '* 作成日　：2009年06月21日
    '* 作成者　：井上　治
    '* 更新日　：2017年04月21日
    '* 更新者　：井上　治
    '* 機能説明：Excelへの時刻データ貼り付けテスト①
    '* 注意事項：※①TimeSerial関数で18:30:00をそのままセット
    '***********************************************************************************************
    Private Sub Button1_Click(ByVal sender As System.Object, _
                              ByVal e As System.EventArgs) Handles Button1.Click
        '-------------------------------------------------------------------------------------------
        ' Excelワークブックを開いてD2セルに時刻をセット①
        Call GP_SetJikoku1(18, 30, 0)
    End Sub

    '***********************************************************************************************
    '* 処理名　：Button2_Click
    '* 機能　　：ボタン②クリックイベント
    '-----------------------------------------------------------------------------------------------
    '* 返り値　：(なし)
    '* 引数　　：(既定)
    '-----------------------------------------------------------------------------------------------
    '* 作成日　：2009年06月21日
    '* 作成者　：井上　治
    '* 更新日　：2017年04月21日
    '* 更新者　：井上　治
    '* 機能説明：Excelへの時刻データ貼り付けテスト②
    '* 注意事項：※②TimeSerial関数で24:30:00をそのままセット ⇒ 例外発生
    '***********************************************************************************************
    Private Sub Button2_Click(ByVal sender As System.Object, _
                              ByVal e As System.EventArgs) Handles Button2.Click
        '-------------------------------------------------------------------------------------------
        ' Excelワークブックを開いてD2セルに時刻をセット②
        Call GP_SetJikoku1(24, 30, 0)
    End Sub

    '***********************************************************************************************
    '* 処理名　：Button3_Click
    '* 機能　　：ボタン③クリックイベント
    '-----------------------------------------------------------------------------------------------
    '* 返り値　：(なし)
    '* 引数　　：(既定)
    '-----------------------------------------------------------------------------------------------
    '* 作成日　：2009年06月21日
    '* 作成者　：井上　治
    '* 更新日　：2017年04月21日
    '* 更新者　：井上　治
    '* 機能説明：Excelへの時刻データ貼り付けテスト③
    '* 注意事項：※③TimeSerial関数で18:30:00を｢日付型差分加算｣してセット
    '***********************************************************************************************
    Private Sub Button3_Click(ByVal sender As System.Object, _
                              ByVal e As System.EventArgs) Handles Button3.Click
        '-------------------------------------------------------------------------------------------
        ' Excelワークブックを開いてD2セルに時刻をセット③
        Call GP_SetJikoku2(18, 30, 0)
    End Sub

    '***********************************************************************************************
    '* 処理名　：Button4_Click
    '* 機能　　：ボタン④クリックイベント
    '-----------------------------------------------------------------------------------------------
    '* 返り値　：(なし)
    '* 引数　　：(既定)
    '-----------------------------------------------------------------------------------------------
    '* 作成日　：2009年06月21日
    '* 作成者　：井上　治
    '* 更新日　：2017年04月21日
    '* 更新者　：井上　治
    '* 機能説明：Excelへの時刻データ貼り付けテスト④
    '* 注意事項：※④TimeSerial関数で24:30:00を｢日付型差分加算｣してセット
    '***********************************************************************************************
    Private Sub Button4_Click(ByVal sender As System.Object, _
                              ByVal e As System.EventArgs) Handles Button4.Click
        '-------------------------------------------------------------------------------------------
        ' Excelワークブックを開いてD2セルに時刻をセット②
        Call GP_SetJikoku2(24, 30, 0)
    End Sub

    '***********************************************************************************************
    ' ■■■ サブ処理 ■■■
    '***********************************************************************************************
    '* 処理名　：GP_SetJikoku1
    '* 機能　　：Excelワークブックを開いてD2セルに時刻をセット
    '-----------------------------------------------------------------------------------------------
    '* 返り値　：(なし)
    '* 引数　　：Arg1 = 時(Integer)
    '* 　　　　　Arg2 = 分(Integer)
    '* 　　　　　Arg3 = 秒(Integer)
    '-----------------------------------------------------------------------------------------------
    '* 作成日　：2009年06月21日
    '* 作成者　：井上　治
    '* 更新日　：2017年04月21日
    '* 更新者　：井上　治
    '* 機能説明：新旧日付型の基準値の差分調整を行なわずにセルに時刻をセット
    '* 注意事項：
    '***********************************************************************************************
    Private Sub GP_SetJikoku1(ByVal intH As Integer, _
                              ByVal intF As Integer, _
                              ByVal intS As Integer)
        '-------------------------------------------------------------------------------------------
        ' Excel出力クラスの初期化(Escキーのイベントはクラス側に実装済)
        Using clsExcel = New clsAboutExcel1(Me, True)
            '---------------------------------------------------------------------------------------
            ' フルパステンプレート名(実行EXEの2階層上のExcelTemplateフォルダになっています)
            Dim objUri1 As New Uri(My.Application.Info.DirectoryPath)
            Dim objUri2 As New Uri(objUri1, g_cnsTempPath)
            Dim objWbk As Excel.Workbook = Nothing                  ' Excel.Workbook
            Dim strFileName As String = Path.Combine(objUri2.LocalPath, g_cnsTemplate) ' ファイル名
            Dim dteTargetTime As Date = TimeSerial(intH, intF, intS) ' 表示する時刻
            Dim strMSGHeader As String = "Excel起動中"              ' メッセージヘッダ
            Try
                '-------------------------------------------
                ' ワークブックを起動(URL上)
                If Not clsExcel.GetWorkbook(strFileName, objWbk, strMSGHeader, True) Then Exit Sub
                ' 差分調整無し
                objWbk.Worksheets(1).Cells(2, 4).Value = dteTargetTime.ToOADate
                ' 保存済み指定
                objWbk.Saved = True
                ' 画面描画再開等終了処理
                Call clsExcel.SuspendExcelProc(objWbk, True)

            Catch ex As Exception
                '-------------------------------------------
                ' 処理中例外メッセージの表示
                Call clsExcel.ShowFatalMessage(g_cnsTitle, strMSGHeader, ex.Message)
                Try
                    ' 例外時後始末(但しExcel応答無しなどではここでの対応は働かない！)
                    Call clsExcel.SuspendExcelProc(objWbk)
                Finally
                    ' ここでは無視するしかない！
                End Try
            End Try
            '---------------------------------------------------------------------------------------
        End Using
    End Sub

    '***********************************************************************************************
    '* 処理名　：GP_SetJikoku2
    '* 機能　　：Excelワークブックを開いてD2セルに時刻をセット
    '-----------------------------------------------------------------------------------------------
    '* 返り値　：(なし)
    '* 引数　　：Arg1 = 時(Integer)
    '* 　　　　　Arg2 = 分(Integer)
    '* 　　　　　Arg3 = 秒(Integer)
    '-----------------------------------------------------------------------------------------------
    '* 作成日　：2009年06月21日
    '* 作成者　：井上　治
    '* 更新日　：2017年04月21日
    '* 更新者　：井上　治
    '* 機能説明：新旧日付型の基準値の差分調整を行なってセルに時刻をセット
    '* 注意事項：
    '***********************************************************************************************
    Private Sub GP_SetJikoku2(ByVal intH As Integer, _
                              ByVal intF As Integer, _
                              ByVal intS As Integer)
        '-------------------------------------------------------------------------------------------
        ' Excel出力クラスの初期化(Escキーのイベントはクラス側に実装済)
        Using clsExcel = New clsAboutExcel1(Me, True)
            '---------------------------------------------------------------------------------------
            ' フルパステンプレート名(実行EXEの2階層上のExcelTemplateフォルダになっています)
            Dim objUri1 As New Uri(My.Application.Info.DirectoryPath)
            Dim objUri2 As New Uri(objUri1, g_cnsTempPath)
            Dim objWbk As Excel.Workbook = Nothing                  ' Excel.Workbook
            Dim strFileName As String = Path.Combine(objUri2.LocalPath, g_cnsTemplate) ' ファイル名
            Dim dteTargetTime As Date = TimeSerial(intH, intF, intS) ' 表示する時刻
            Dim strMSGHeader As String = "Excel起動中"              ' メッセージヘッダ
            Try
                '-------------------------------------------
                ' ワークブックを起動(URL上)
                If Not clsExcel.GetWorkbook(strFileName, objWbk, strMSGHeader, True) Then Exit Sub
                ' 差分調整有り
                objWbk.Worksheets(1).Cells(2, 4).Value = _
                    dteTargetTime.Add(g_cnsAddTimeforCell).ToOADate
                ' 保存済み指定
                objWbk.Saved = True
                ' 画面描画再開等終了処理
                Call clsExcel.SuspendExcelProc(objWbk, True)

            Catch ex As Exception
                '-------------------------------------------
                ' 処理中例外メッセージの表示
                Call clsExcel.ShowFatalMessage(g_cnsTitle, strMSGHeader, ex.Message)
                Try
                    ' 例外時後始末(但しExcel応答無しなどではここでの対応は働かない！)
                    Call clsExcel.SuspendExcelProc(objWbk)
                Finally
                    ' ここでは無視するしかない！
                End Try
            End Try
            '---------------------------------------------------------------------------------------
        End Using
    End Sub

    '-------------------------------------<< End of Source >>---------------------------------------
End Class

何が問題なのでしょうか。

23:59:59を超えない時刻をExcelワークシートのセルにセットするのは何も問題ないのですが、 23:59:59を超える時刻をExcelワークシートのセルにセットする時点でエラーが発生してしまいます。
このサンプルで言うと、②がそうで、起動させると、

となります。エラー処理を入れてあるので、その後にExcelは表示されますが、D2セルには「24:30」は表示されず、元々登録してあった「18:00」が表示されたままになります。

Excelのセル上でも２４時以上の値は「１日＋時分」として扱われますが、おそらく.NET(VB2005/2008)でも同様の扱いで、その時に発生する日付がExcelVBAや旧VBの「日付型」からすると有効範囲外になってしまうということなのでしょう。

ちなみに、①と②の処理からは「GP_SetJikoku1」というサブ処理が呼ばれていて、 Excelのセルに時刻をセットする場合の右辺には「ToOADate」プロパティを加えて「シリアル値」に変換させています。
このエラーの問題については「ToOADate」プロパティの有無にかかわらず同じ結果になりました。

解決のキーワードは「693593」です。

上記のエラーが発生した時に、ならば新旧「日付型」の差分を調整してしまえば良いのだろうと、基準値どうしを差し引いた値を算出しました。その値が「693593」です。
たぶん、西暦紀元から「1899年12月30日」までの「日数」ということなのでしょう。


    Private Sub Button1_Click(ByVal sender As System.Object, _
                              ByVal e As System.EventArgs) Handles Button1.Click
        Const cnsOLDDate As Date = #12/30/1899#     ' 旧VBの日付型基準値
        Const cnsNewTime As Date = #12:00:00 AM#    ' 新VBの日付型基準値
        MessageBox.Show((cnsOLDDate - cnsNewTime).TotalDays.ToString)
    End Sub

このような方法で確認できます。

この「差分値」を定数的に保持しておくことにしました。


    Private ReadOnly g_cnsAddTimeforCell As TimeSpan = New TimeSpan(693593, 0, 0, 0)

最初は、時刻の値が２４時以上（23:59:59を超える）の時に加えてやろうと考えたのですが、やってみたところ「無条件に加える」で問題ないので単純に加えるようにしました。このサンプルでは「GP_SetJikoku2」がその処理で、


    '-----------------------------------------------------------------------
    ' D2セルに時刻をセット(新旧日付型差分調整)
    objWBK.Worksheets(1).Cells(2, 4).Value = _
        dteTargetTime.Add(g_cnsAddTimeforCell).ToOADate
    '-----------------------------------------------------------------------

という記述になっています。こちらの方法を呼んでいるのが③と④です。④が②と同じ「24:30」をセットするものですがエラーにはならずにExcelのセルにも「24:30」と表示され、数式バーには「1900/1/1 0:30:00」と表示されます。

もしかしたら、この問題に当たってセルの書式を「文字列」にするなどで対処している方もいるかもしれないですが、この方法ならセルに手入力した時刻と同様に処理できます。

※なお、本処理では例外発生時の「後始末」を行なっています。