VBAで72時間タイマーがオーバーフローします…

VBA初心者です。会社で最大７２時間のカウントダウンタイマーを作ってと言われ、
時間と分をセル入力して起動するように作ってみましたが、何故か９時間以上に設定するとオーバーフローが発生します…。ネットから対策方法を探してInteger、Longの長整数型で宣言してみましたが、うまくいきません。
Format、Timeserial関数あたりが問題？だとは思いますが、かといって対策方法がわかりません。
ちなみに時間・分・秒表示は必須です。どなたかわかる方ご教授下さい！

以下構文になります。

Sub timer()
Dim limit As Date, cnt_d As Double

limit = DateAdd("n", Range("D4"), Time)
limit = DateAdd("h", Range("B4"), Time)

UserForm1.Show vbModeless
UserForm1.Repaint

Do
cnt_d = DateDiff("s", Time, limit)

UserForm1.TextBox2 = Format(TimeSerial(0, 0, cnt_d), "hh:nn:ss")
If UserForm1.TextBox2 = "00:00:00" Then Exit Do

DoEvents
Loop

End Sub

質問者からの補足コメント

• 回答ありがとうございます。
  試してみましたが、オーバーフローは無いものの表示が正しくありません…何故か0表示のままになります。
  まれに61分表示にもなります。なぜでしょう？？

  No.2の回答に寄せられた補足コメントです。 補足日時：2019/11/18 17:31

No.5 ベストアンサー 回答者： tatsu99 回答日時： 2019/11/19 00:08

＞試してみましたが、オーバーフローは無いものの表示が正しくありません…何故か0表示のままになります。

＞まれに61分表示にもなります。なぜでしょう？？
いくつか、原因が考えられますが、下記の点を修正しました。
１．アクティブシートのB4,D4を最初のタイマー値にしているが、それだと、アクティブシートが変わる可能性があるので
明示的にシートを指定するようにした。（シート名を"Sheet1"にしています。あなたの環境にあわせてシート名を変えてください）
又、あなたが提示されたコードでは、D4（分）は、無視されるので、この値も組み込むようにしました。
B4（時）の最大値は100時間にしています。B4,D4で不正な値の場合は、エラーにするようにしました。
２．Time関数は、翌日になると値が０に戻るので、Now関数に変えました。
３．完了後に"timeout"をメッセージボックスにだしています。不要なら削除してください。

以下のようにしてください。
----------------------------------------------------
Sub timer()
Dim t_hh As Long
Dim t_nn As Long
Dim t_ss As Long
Dim err As Boolean
Dim ws As Worksheet
Dim t1 As Variant
Dim t2 As Variant
Dim t_diff As Double
Dim diff As Long
Set ws = Worksheets("Sheet1")
err = False
t_hh = ws.Range("B4").Value
t_nn = ws.Range("D4").Value
If t_hh < 0 Or t_hh > 100 Or t_nn < 0 Or t_nn > 59 Then err = True
t_ss = t_hh * 60 * 60 + t_nn * 60
If t_ss = 0 Then err = True
If err = True Then
MsgBox ("タイマー不正")
Exit Sub
End If
t1 = Now
t2 = t1 + t_ss

UserForm1.Show vbModeless
UserForm1.Repaint
Do
t2 = Now
diff = t_ss - DateDiff("s", t1, t2)
UserForm1.TextBox2 = sec2hhmmss(diff)
If diff <= 0 Then Exit Do
DoEvents
Loop
MsgBox ("timeout")
End Sub

Public Function sec2hhmmss(ByVal cnt_d As Long) As String
Dim hh As Long
Dim nn As Long
Dim ss As Long
Dim amari As Long
hh = cnt_d \ (60 * 60)
amari = cnt_d Mod (60 * 60)
nn = amari \ 60
ss = amari Mod 60
sec2hhmmss = Format(hh, "00") & ":" & Format(nn, "00") & ":" & Format(ss, "00")
End Function

この回答へのお礼

ありがとうございました。かなり内容が複雑で自分には難解ですが、狙いどうりの動作です。
本当に助かりました。

お礼日時：2019/11/19 09:55

No.4 回答者： GooUserラック 回答日時： 2019/11/18 19:25

ついでに言うと終了判定は「If UserForm1.TextBox2 = "00:00:00" Then Exit Do」ではなく「If cnt_d <= 0 Then Exit Do」にされた方が良いですよ。

この回答へのお礼

アドバイスありがとうございます。

お礼日時：2019/11/19 09:55

No.3 回答者： GooUserラック 回答日時： 2019/11/18 18:36

検証したわけではありませんが以下ではどうですか？

Sub timer()
Dim limit As Date, cnt_d As Double

limit = DateAdd("n", Range("D4"), Time)
limit = DateAdd("h", Range("B4"), Time)

UserForm1.Show vbModeless
UserForm1.Repaint

Do
　cnt_d = DateDiff("s", Time, limit)

　UserForm1.TextBox2 = Format(cnt_d / 86400, "hh:nn:ss")
　If UserForm1.TextBox2 = "00:00:00" Then Exit Do

DoEvents
Loop

End Sub

この回答へのお礼

残念ながらうまくいきませんでしたが、アドバイスありがとうございました。

お礼日時：2019/11/19 09:57

No.2 回答者： tatsu99 回答日時： 2019/11/18 14:23

cnt_dをhh:mm:ss形式の文字列に変換する関数を自前で作成しました。

下記の関数を
UserForm1.TextBox2 = sec2hhmmss(cnt_d)
として呼び出してください。hhは23時間の場合でも、その数値が表示されます。
（72時間の場合、72:00:00のようになります。１００時間なら100:00:00になります）


Public Function sec2hhmmss(ByVal cnt_d As Long)
Dim hh As Long
Dim nn As Long
Dim ss As Long
Dim amari As Long
hh = cnt_d \ (60 * 60)
amari = cnt_d Mod (60 * 60)
nn = amari \ 60
ss = amari Mod 60
sec2hhmmss = Format(hh, "00") & ":" & Format(nn, "00") & ":" & Format(ss, "00")
End Function

No.1 回答者： よろずやkinchan 回答日時： 2019/11/18 12:40

TimeSerial(0, 0, cnt_d)

時、分、秒に入れられる値は、Integer の範囲の値です。
最大 32767 になります。

この回答へのお礼

アドバイスありがとうございます。

お礼日時：2019/11/19 09:56