VBAカウントダウンタイマーの2個同時起動は不可？

Question

VBA初心者です。

先日このサイトに助けてもらいVBAにてカウントダウンタイマーを作成させてもらいましたが、
2個同時起動が必要になり2個目を起動させると、最初のタイマーが停止してしまいます…。
元々マクロの同時起動自体が不可なのでしょうか？

解決策があればご教授お願いします！

よろずやkinchan · Accepted Answer

Option Explicit

Private Const Maxi = 2
Private myTextBox(1 To Maxi)      As MSForms.TextBox
Private myToggleButton(1 To Maxi) As MSForms.ToggleButton
Private EndTime(1 To Maxi)        As Date
Private EndFlg                    As Boolean

Private Function IsTimeX(ByVal txt As String) As Boolean
    IsTimeX = (txt Like "##:[0-5]#:[0-5]#")
End Function

Private Function Sec2hhmmss(ByVal Cnt_d As Long) As String
    Dim hh As Long, nn As Long, ss As Long, 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 Sub TextBox_KeyDown(ByVal i As Long, ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    With myTextBox(i)
        Select Case Shift * &H100 + KeyCode
            Case vbKey0 To vbKey5, vbKeyNumpad0 To vbKeyNumpad5
                Select Case .SelStart
                    Case 0, 1, 3, 4, 6, 7
                    Case Else: KeyCode = 0
                End Select
            Case vbKey6 To vbKey9, vbKeyNumpad6 To vbKeyNumpad9
                Select Case .SelStart
                    Case 0, 1, 4, 7
                    Case Else: KeyCode = 0
                End Select
            Case 186 '":"
                Select Case .SelStart
                    Case 2, 5
                    Case Else: KeyCode = 0
                End Select
            Case vbKeyLeft, vbKeyRight
            Case Else: KeyCode = 0
        End Select
        .SelLength = 1
    End With
End Sub

Private Sub TextBox_KeyUp(ByVal i As Long, ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    With myTextBox(i)
        Select Case Shift * &H100 + KeyCode
            Case vbKey0 To vbKey9, vbKeyNumpad0 To vbKeyNumpad9
            Case 186 '":"
            Case vbKeyLeft:  If .SelStart > 0 Then .SelStart = .SelStart - 1
            Case vbKeyRight: If .SelStart = 7 Then KeyCode = 0
        End Select
        .SelLength = 1
    End With
End Sub

Private Sub TextBox_MouseUp(ByVal i As Long, ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    myTextBox(i).SelLength = 1
End Sub

Private Function TimeValueX(ByVal txt As String) As Date
    Dim Item() As String:   Item = Split(txt, ":")
    TimeValueX = (Item(0) + (Item(1) + Item(2) / 60) / 60) / 24
End Function

Private Sub myToggleButton_Click(ByVal i As Long)
    If myToggleButton(i).Value Then
        If IsTimeX(myTextBox(i).Text) Then
            EndTime(i) = TimeValueX(myTextBox(i).Text) + Now()
            myTextBox(i).Locked = True
            myToggleButton(i).Caption = "Stop"
        Else
            myToggleButton(i).Value = False
            Call MsgBox("入力値に誤りがあります")
        End If
    Else
        myTextBox(i).Locked = False
        myToggleButton(i).Caption = "Start"
    End If
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Call TextBox_KeyDown(1, KeyCode, Shift)
End Sub

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Call TextBox_KeyUp(1, KeyCode, Shift)
End Sub

Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call TextBox_MouseUp(1, Button, Shift, X, Y)
End Sub

Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Call TextBox_KeyDown(2, KeyCode, Shift)
End Sub

Private Sub TextBox2_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Call TextBox_KeyUp(2, KeyCode, Shift)
End Sub

Private Sub TextBox2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call TextBox_MouseUp(2, Button, Shift, X, Y)
End Sub

Private Sub ToggleButton1_Click()
    Call myToggleButton_Click(1)
End Sub

Private Sub ToggleButton2_Click()
    Call myToggleButton_Click(2)
End Sub

よろずやkinchan · Answer

Private Sub UserForm_Activate()
    Do
        Dim i As Long
        For i = 1 To Maxi
            If myTextBox(i).Locked Then
                Dim Diff As Long: Diff = DateDiff("s", Now, EndTime(i))
                myTextBox(i).Text = Sec2hhmmss(Diff)
                If Diff <= 0 Then
                    myTextBox(i).Locked = False
                    myToggleButton(i).Value = False
                    myToggleButton(i).Caption = "Start"
                End If
            End If
        Next i
        DoEvents
    Loop Until EndFlg
End Sub

Private Sub UserForm_Initialize()
    Dim i As Long
    For i = 1 To Maxi
        Set myTextBox(i) = Me.Controls("TextBox" & i)
        With myTextBox(i)
            .Locked = False
            .Text = "00:00:00"
            .SelStart = 0
            .SelLength = 1
        End With
        Set myToggleButton(i) = Me.Controls("ToggleButton" & i)
        myToggleButton(i).Caption = "Start"
        myToggleButton(i).Value = False
    Next i
    EndFlg = False
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    EndFlg = True
End Sub

Gen_bamboo · Answer

Excelとして１つのアプリケーションで動いているので、難しいと思います。
VBAを書き換える方がよさそうです。
非同期処理とか使ったらマルチスレッド出来るんじゃないでしょうか。
https://marimox.net/excelvba-multithread
https://excel-ubara.com/excelvba4/VBA_CLASS_06.html

fujillin · Answer

こんにちは

現状が、どのような方法で実現なさっているのか不明ですが・・・

例えば、OnTimeなどで、1秒ごとに各タイマーの値をセット（修正表示）して回るような方式にしておけば、タイマーが複数あっても問題なく動作するでしょう。

一方で、エクセル等のマクロはシングルスレッドらしいので、同時に複数のマクロを実行させることは難しいかもしれません。（←確信のない情報です）

※ 何らかの値を変数等に記憶しておくような方法をとる場合は、それらが混同されないようにしておく必要があります。

VBAカウントダウンタイマーの2個同時起動は不可？

Option Explicit

Private Sub UserForm_Activate()

Excelとして１つのアプリケーションで動いているので、難しいと思います。

こんにちは

似たような質問が見つかりました

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

関連するカテゴリからQ&Aを探す

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

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング