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
No.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
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) VBAで組み合わせ算出やCOUNTIFSの処理を高速化したいです。 4 2022/04/07 02:38
- Excel(エクセル) VBAについて 3 2022/06/19 18:19
- Visual Basic(VBA) 別シートから年齢別の件数をカウントしたい 6 2023/01/23 12:00
- Visual Basic(VBA) ExcelVBAに関する質問 3 2023/02/17 10:47
- Visual Basic(VBA) エクセルのマクロについて教えてください。 3 2023/02/22 08:53
- Visual Basic(VBA) エクセルのマクロについて教えてください。 3 2023/02/17 11:59
- Excel(エクセル) 2つのVBAを一緒にしたら機能しなくなりました(エクセル) 7 2022/06/02 12:41
- Visual Basic(VBA) VBAで質問ですが、皆さんはどの様に導き出しているのでしょうか? 6 2022/05/03 21:53
- Visual Basic(VBA) VBA 請求書自動作成 3 2022/04/24 01:58
- Visual Basic(VBA) 【VBA】特定のワードが入っている行全体を塗りつぶしたい 4 2022/04/20 15:22
このQ&Aを見た人はこんなQ&Aも見ています
-
プロが教えるわが家の防犯対策術!
ホームセキュリティのプロが、家庭の防犯対策を真剣に考える 2組のご夫婦へ実際の防犯対策術をご紹介!どうすれば家と家族を守れるのかを教えます!
-
VBAカウントダウンタイマーの2個同時起動は不可?
Visual Basic(VBA)
-
Excel(VBA)でSetTimer関数を使用する時..
Excel(エクセル)
-
VBA Application.OnTime について
Excel(エクセル)
-
-
4
Excel(エクセル) VBA プロシージャーをミリ秒で繰り返し実行する方法
Excel(エクセル)
-
5
マルチスレッドを実現したい
Visual Basic(VBA)
-
6
エクセルでの現在時刻入力
Excel(エクセル)
-
7
エクセルVBAにおけるON TIMEメソッドの解除方法について
Visual Basic(VBA)
-
8
VB カウントダウンタイマーの作り方
Visual Basic(VBA)
-
9
VBA(エクセル)で自動的にボタンをクリックさせるには
その他(プログラミング・Web制作)
-
10
タイマーマクロの二重起動防止をしたい
Visual Basic(VBA)
-
11
エクセル マクロの同時実行について
Visual Basic(VBA)
-
12
エクセルVBA 時間のカウントダウン
Excel(エクセル)
-
13
メッセージボックスに表示する文字を大きくしたい
Excel(エクセル)
-
14
エクセルのストップウォッチ
Visual Basic(VBA)
-
15
「一定の時間間隔で5秒毎にMacro1を実行する」
Excel(エクセル)
-
16
Excel VBAでのWorksheet_Changeが動作しない原因
Excel(エクセル)
-
17
Excelでタイマーの一時停止するボタンのコードは
Visual Basic(VBA)
-
18
エクセル マクロVBAで経過時間を分で表す方法
Excel(エクセル)
-
19
VB6.0でTimerを複数使う
Visual Basic(VBA)
-
20
private subモジュールを他のモジュールから呼び出して使う方法を教えてください(-.-)
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
「コンパイルエラー :ユーザ定...
-
受話器から自分の話した声が返...
-
光電話が発信できるが、着信しない
-
光デジタル・光アナログとは?
-
留守電のメッセージを消してし...
-
固定電話の声が相手に届かない
-
会社で使われている電話機
-
三者間通話が可能なNTT回線の電...
-
ISDN専用電話?
-
電話2回線を1つの電話機で受...
-
固定電話にかけたら呼び出し音...
-
INSネット1500の休止費用
-
電話を人に譲るとき
-
NTT TA INSメイト V30 Tower
-
NTTディジタル電話S-2000 INS1500
-
[黒電話] フックボタン連打で...
-
外部から企業内内線電話に直接...
-
アナログ回線で2台の電話を使用...
-
ISDN回線でアナログモデムは利...
-
Dチャネルは具体的に何を制御...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
イタリア語で「小さな星の光」は?
-
VBAカウントダウンタイマーの2...
-
Access 指定した文字列を取得...
-
「コンパイルエラー :ユーザ定...
-
受話器から自分の話した声が返...
-
外部から企業内内線電話に直接...
-
トーンに切り替えるにはどうし...
-
光電話が発信できるが、着信しない
-
固定電話の声が相手に届かない
-
ACR機能の解除
-
会社で使われている電話機
-
ビジネスホンのジャック(6極4...
-
電話子機の盗聴の可能性について
-
ピンク電話を自宅で使う
-
電話機のトーン切り替えボタン...
-
固定電話にかけたら呼び出し音...
-
コードレス電話の子機でヘッド...
-
電話の接続について勉強したい
-
回線にノイズ・・・FAXが受信で...
-
留守電のメッセージを消してし...
おすすめ情報