プロが教えるわが家の防犯対策術!

VBAで最大100時間のカウントダウンタイマー2個仕様を作成中の初心者です。

別スレッドで2個同時起動させようとしましたがExcelでのマルチスレッド化は不可という事で、同スレッド内で2個同時起動に切り替えました。
ただ2個目が正しく起動しません…。何故か00:00:00からカウントダウンをスタートしてしまいます。Excelシートのセルに時間と分を入力して起動させる方式です。
どなたか何が悪いのか教えてもらえると助かります。

Sub timer()
Dim t_hh As Long
Dim t_nn As Long
Dim t_ss As Long
Dim ta_hh As Long
Dim ta_nn As Long
Dim ta_ss As Long
Dim err As Boolean
Dim ws As Worksheet
Dim t1 As Variant
Dim t2 As Variant
Dim t3 As Variant
Dim t_diff As Double
Dim diff As Long
Dim t_diff2 As Double
Dim diff2 As Long
Set ws = Worksheets("Sheet1")
err = False
t_hh = ws.Range("B4").Value
t_nn = ws.Range("D4").Value
ta_hh = ws.Range("B13").Value
ta_nn = ws.Range("D13").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 ("タイマー不正")
If ta_hh < 0 Or ta_hh > 100 Or ta_nn < 0 Or ta_nn > 59 Then err = True
ta_ss = ta_hh * 60 * 60 + ta_nn * 60
If ta_ss = 0 Then err = True
If err = True Then
MsgBox ("タイマー不正")

Exit Sub
End If
End If
t1 = Now
t2 = t1 + t_ss
t3 = t1 + ta_ss

UserForm1.Show vbModeless
UserForm1.Repaint
Do
t2 = Now
t3 = Now
diff = t_ss - DateDiff("s", t1, t2)
diff2 = ta_ss - DateDiff("s", t1, t2)
UserForm1.TextBox2 = sec2hhmmss(diff)
UserForm1.TextBox3 = sec2hhmmss(diff2)

If diff <= 0 Then Exit Do
If UserForm1.TextBox2 <= "30:00:00" Then UserForm1.TextBox2.BackColor = vbYellow
If UserForm1.TextBox2 <= "20:00:00" Then UserForm1.TextBox2.BackColor = vbRed
If UserForm1.TextBox2 > "30:00:00" Then UserForm1.TextBox2.BackColor = vbWhite
If diff <= 0 Then Exit Do
If UserForm1.TextBox3 <= "30:00:00" Then UserForm1.TextBox3.BackColor = vbYellow
If UserForm1.TextBox3 <= "20:00:00" Then UserForm1.TextBox3.BackColor = vbRed
If UserForm1.TextBox3 > "30:00:00" Then UserForm1.TextBox3.BackColor = vbWhite
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

A 回答 (2件)

前の回答者です。

とりあえず、修正しておきました。
Sub timer()
Dim t_hh As Long
Dim t_nn As Long
Dim t_ss As Long
Dim ta_hh As Long
Dim ta_nn As Long
Dim ta_ss As Long
Dim err As Boolean
Dim ws As Worksheet
Dim t1 As Variant
Dim t2 As Variant
Dim t3 As Variant
Dim t_diff As Double
Dim diff As Long
Dim t_diff2 As Double
Dim diff2 As Long
Set ws = Worksheets("Sheet1")
err = False
t_hh = ws.Range("B4").Value
t_nn = ws.Range("D4").Value
ta_hh = ws.Range("B13").Value
ta_nn = ws.Range("D13").Value
'タイマー1チェック
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 ("タイマー1不正")
Exit Sub
End If
'タイマー2チェック
If ta_hh < 0 Or ta_hh > 100 Or ta_nn < 0 Or ta_nn > 59 Then err = True
ta_ss = ta_hh * 60 * 60 + ta_nn * 60
If ta_ss = 0 Then err = True
If err = True Then
MsgBox ("タイマー2不正")
Exit Sub
End If
t1 = Now
UserForm1.Show vbModeless
UserForm1.Repaint
Do
t2 = Now
diff = t_ss - DateDiff("s", t1, t2)
diff2 = ta_ss - DateDiff("s", t1, t2)
If diff >= 0 Then
UserForm1.TextBox2 = sec2hhmmss(diff)
UserForm1.TextBox2.BackColor = set_color(diff)
End If
If diff2 >= 0 Then
UserForm1.TextBox3 = sec2hhmmss(diff2)
UserForm1.TextBox3.BackColor = set_color(diff2)
End If
If diff < 0 And diff2 < 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

Private Function set_color(ByVal cnt_d As Long) As Long
If (cnt_d > 30 * (60& * 60&)) Then
set_color = vbWhite
ElseIf (cnt_d > 20 * (60& * 60&)) Then
set_color = vbYellow
Else
set_color = vbRed
End If
End Function
    • good
    • 1
この回答へのお礼

ありがとうございました。うまくいきました!

お礼日時:2019/11/25 09:54

>2個目が正しく起動しません…。



1個目用の変数と2個目用の変数が、ごっちゃになってます。
    • good
    • 1
この回答へのお礼

ご指摘ありがとうございます。
いったいどこの部分が悪いのでしょう??

お礼日時:2019/11/24 11:27

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A