Teamsで離席しても離席にしない(メモ)

放置しても離席にならない。
エクセルのA1をセレクトし、「下キー」入力、またA1にセレクトする処理
※・キーボードによるかもしれないが、numLockをオフにする必要がある
　・「下キー」が入力されるので、一時的に作業する際は、Stopする必要がある。

ボタンは『フォームコントロールコントロール』

メイン処理

Dim Stop_flg As Boolean
'Startボタンの処理
Sub Start_Click()

  Dim time As Date
  time = Range("C3").Value
  Range("C3").Interior.Color = RGB(77, 233, 110)  'タイマーの色を緑にする
  Stop_flg = False

  Do While time > "00:00:01"

    
    '''カウント処理　以下の処理だとExcelのボタン操作を受け付ける'''
      Dim cunt_st As Double
      Const cunt_ed As Double = 1
      '待ち時間の開始時間の取得
      cunt_st = Timer
      '開始時間から停止時間数値を超えるまで無限ループ
      Do Until Timer - cunt_st >= cunt_ed
        DoEvents
        If Stop_flg = True Then Exit Do
      Loop
      If Stop_flg = True Then Exit Do
    
    '表示用のタイマー更新
    time = DateAdd("s", -1, time)
    Range("C3").Value = time
    
    '疑似操作の処理A1を選択し、下キー入力
    Range("A1").Select
    SendKeys "{DOWN}"

  Loop
  Range("C3").Interior.ColorIndex = xlNone  'タイマーの色を元に戻す

End Sub

'Stopボタンの処理
Private Sub Stop_Click()
 Stop_flg = True

End Sub

'+1分ボタンの処理
Sub Plus1min()
Dim time As Date
time = Range("C3").Value
time = DateAdd("n", 1, time)
Range("C3").Value = time

End Sub

'-1分ボタンの処理
Sub Minus1min()
Dim time As Date
time = Range("C3").Value
If time < "00:01:00" Then
  time = "00:00:00"
Else
  time = DateAdd("n", -1, time)
End If

Range("C3").Value = time
End Sub

'+10分ボタンの処理
Sub Plus10min()
Dim time As Date
time = Range("C3").Value
time = DateAdd("n", 10, time)
Range("C3").Value = time
End Sub

'　-10分ボタンの処理
Sub Minus10min()
Dim time As Date
time = Range("C3").Value
If time < "00:10:00" Then
  time = "00:00:00"
Else
  time = DateAdd("n", -10, time)
End If

Range("C3").Value = time
End Sub
Sub Reset()
Range("C3").Value = "00:00:00"

End Sub