Excelのマクロで指定時間にダイアログを表示させてみる

# はじめに

　前回のアドベントカレンダー(クリスマスver.)の時は、参加してみたいけど**"技術"**そんなに詳しくないし…と参加を見送りました。でも完成した冊子を見て「いいなーかっこいいな」と思ったので、今回は思い切って参加してみました。考えてみると意外と案が浮かんできました。**休憩を促すアラームを作る(Excelのマクロで指定時間にダイアログを表示させてみる)**のテーマで記事を書いていきます。

# 仕様

###【やりたいこと】

####休憩を促すアラームを作る
###＋実装の勉強（途中からこっちメイン）

###【最低限】

- [ダイアログを表示する](#ダイアログを表示する)
- [指定の時間にダイアログを表示する](#指定の時間にダイアログを表示する)
- [時間によって違うメッセージを表示する](#時間によって違うメッセージを表示する)

###【＋α】

- [実行するときのボタンを作成する](#実行するときのボタンを作成する)
- [押したボタンによって処理を分ける](#押したボタンによって処理を分ける)
- [休憩回数の記録を取る](#休憩回数の記録を取る)

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/665545/2330162d-c361-bee2-676a-4ffe958c701f.png)

こんなのを作りました。（実際に作ったもの）

# 作業記録
####ダイアログを表示する

```
 Msgbox ("さぁでるかな")
```

####指定の時間にダイアログを表示する

```
 Application.OnTime EarliestTime:=TimeValue("17:45:55"), Procedure:="Breaktime"
```
上の記述で、指定の時間(17:45:55)にダイアログを表示するメソッド(Breaktime)を実行しています。

#### 時間によって違うメッセージを表示する

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/665545/3ecee431-418e-4a1f-5b53-1186fa0bf9d2.png)

```言語:Schejule(メソッド開始はこっち)
 '繰り返し処理開始
 For i = 2 To 8
  'セルの値の時間になったら"Breaktime(i, nowdate)"メソッドを実行する
  Application.OnTime EarliestTime:=shMane.Cells(i, 3).Value, Procedure:="'Breaktime " & i & "," & nowDate & "'"
 Next i
```

```言語:Breaktime(引数は省略)
 'ダイアログを出す(メッセージ　＆　(改行して)　＆　共通質問,　ボタンの種類,　タイトル)
 MsgBox(shMane.Cells(i, 4) & vbNewLine & shMane.Cells(10, 4), vbYesNoCancel, shMane.Cells(i, 2))
```

#### 実行するときのボタンを作成する

####(作業手順)
挿入→図形→好きな図形を選ぶ→図形を右クリックする→マクロの登録→連携させるメソッドを選ぶ

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/665545/19e8c2b3-f598-af5d-0a00-d411854e2028.png)

こういうボタンができる。

#### 押したボタンによって処理を分ける

```
 'はいボタン　今休憩とる
 If ans = 6 Then
  shReco.Cells(2, nowDate).Value = shReco.Cells(2, nowDate).Value + 1
```
休憩回数(shReco.Cells(2, nowDate).Value)に1を加える。

```
 'いいえボタン　今休憩とれない(再度ダイアログを表示する)
 ElseIf ans = 7 Then
  Application.OnTime Now() + TimeValue("00:10:00"), "'Breaktime " & i & "," & nowDate & "'"
```
10分後に"Breaktime(i, nowdate)"メソッドを実行する。

```
 'キャンセルボタン　休憩をパスする
 Else
  MsgBox shMane.Cells(12, 4), vbOKOnly, shMane.Cells(12, 2)
 End If
```
休憩を促す内容のダイアログを表示する。

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/665545/84089738-d51d-d001-d3e7-39b595311db5.png)

#### 休憩回数の記録を取る

```言語:Schejule()
 '休憩回数を記録するための処理
 Dim nowDate As Integer
 nowDate = Day(Date) + 1
 
 '今日の日付の回数に0を設定する
 shReco.Cells(2, nowDate).Value = 0
```

```言語:Breaktime()
 'はいボタン　今休憩とる
 If ans = 6 Then
  shReco.Cells(2, nowDate).Value = shReco.Cells(2, nowDate).Value + 1
```
休憩回数に0を設定しておいて、
「はい」ボタンが押されたときは1を加える。

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/665545/af05bf4e-0c73-fa71-eda0-ec595487ed64.png)

つづき

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/665545/db43e257-df30-9221-056f-b01cb393a008.png)


月末になったら日付と回数をコピーして履歴に貼り付けます。
※履歴は手動で貼り付ける。

ここまでで大体は完成です。

# つまづいたところ

#### 課題１　メソッド呼び出しで引数を渡す

```
 Application.OnTime EarliestTime:=shMane.Cells(i, 3).Value, Procedure:="'Breaktime " & i & "," & nowDate & "'"
```
```
 Application.OnTime Now() + TimeValue("00:10:00"), "'Breaktime " & i & "," & nowDate & "'"
```
Breaktime(i, nowdate)と呼びたいときは、"'Breaktime " & i & "," & nowDate & "'"と書けば良いみたいです。

#### 課題２　アクティブブックじゃなくなったときのための対処

```  
 'シート名管理
 Dim shMane As Worksheet
 Set shMane = Worksheets("マクロ管理")
 'シート名管理
 Dim shReco As Worksheet
 Set shReco = Worksheets("記録")

 'ダイアログを出す(メッセージ＋共通質問,ボタン種類,タイトル)
 ans = MsgBox(shMane.Cells(i, 4) & vbNewLine & shMane.Cells(10, 4), vbYesNoCancel, shMane.Cells(i, 2))
```
マクロ作成している時は問題なかったんですけど、
他の作業やってる最中で(マクロ動いてるブックが)アクティブブックじゃなくなると、
「そんなシートないよ」ってエラーになるみたいです。
なのでブックを指定します。

```
 'book名管理(excelがアクティブシートじゃないときのための設定)
 Dim breakBook As Workbook
 Set breakBook = Workbooks("休憩取得効率アップツール.xlsm")
 
 'シート名管理
 Dim shMane As Worksheet
 Set shMane = breakBook.Worksheets("マクロ管理")
 'シート名管理
 Dim shReco As Worksheet
 Set shReco = breakBook.Worksheets("記録")

 'ここより下は変更なし
 'ダイアログを出す(メッセージ＋共通質問,ボタン種類,タイトル)
 ans = MsgBox(shMane.Cells(i, 4) & vbNewLine & shMane.Cells(10, 4), vbYesNoCancel, shMane.Cells(i, 2))
```
って書き換えたら無事動きました。(あー良かった)
完成と思って実用し始めたらこのエラーが起きて焦りました(笑)

# 参考URL

- ダイアログのボタンの種類　https://www.officepro.jp/excelvba/dialog/index2.html

- 指定の時間にダイアログを表示する　https://www.moug.net/tech/exvba/0130013.html

- ダイアログのメッセージを改行する　https://www.officepro.jp/excelvba/dialog/index4.html

- 指定時間までマクロを停止する(今回の実装では使っていません。)　https://www.moug.net/tech/exvba/0130014.html

- 指定時間後にメソッドを実行する　https://excel-ubara.com/excelvba1/EXCELVBA420.html

- ブック名を設定する　https://www.officepro.jp/excelvba/book/index1.html

# おわりに

マクロを1から書いてみて、調べるのも含めて楽しかったです。
**とりあえずエントリー**してみるの大事だと思いました。
最後に全コード載せておきます。

```言語:Schejule()
'このメソッドを実行する
Sub Schejule()
 '指定の時間にダイアログを出す(休憩を促す)
 
 '繰り返し処理のためのカウンター変数
 Dim i As Integer
 
 'シート名管理
 Dim shMane As Worksheet
 Set shMane = Worksheets("マクロ管理")
 'シート名管理
 Dim shReco As Worksheet
 Set shReco = Worksheets("記録")
 
 '休憩回数を記録するための処理
 Dim nowDate As Integer
 nowDate = Day(Date) + 1
 
 '今日の日付の回数に0を設定する
 shReco.Cells(2, nowDate).Value = 0
 
 '繰り返し処理開始
 For i = 2 To 8
  'セルの値の時間になったら"Breaktime(i, nowdate)"メソッドを実行する
  Application.OnTime EarliestTime:=shMane.Cells(i, 3).Value, Procedure:="'Breaktime " & i & "," & nowDate & "'"
 Next i

End Sub
```

```言語:Breaktime(引数は省略)
'"Schejule"メソッドから呼び出される
Sub Breaktime(i As Integer, nowDate As Integer)
 'ダイアログを表示して、押したボタンによって別の処理を行う

 'ダイアログのどのボタンを押したかを判別するための変数
 Dim ans As Integer
 
 'book名管理(excelがアクティブシートじゃないときのための設定)
 Dim breakBook As Workbook
 Set breakBook = Workbooks("休憩取得効率アップツール.xlsm")
 
 'シート名管理
 Dim shMane As Worksheet
 Set shMane = breakBook.Worksheets("マクロ管理")
 'シート名管理
 Dim shReco As Worksheet
 Set shReco = breakBook.Worksheets("記録")

 'ダイアログを出す(メッセージ＋共通質問,ボタン種類,タイトル)
 ans = MsgBox(shMane.Cells(i, 4) & vbNewLine & shMane.Cells(10, 4), vbYesNoCancel, shMane.Cells(i, 2))
 
 'ボタン毎の処理
 'はいボタン　今休憩とる
 If ans = 6 Then
  shReco.Cells(2, nowDate).Value = shReco.Cells(2, nowDate).Value + 1
  
 'いいえボタン　今休憩とれない(再度ダイアログを表示する)
 ElseIf ans = 7 Then
  Application.OnTime Now() + TimeValue("00:10:00"), "'Breaktime " & i & "," & nowDate & "'"
  
 'キャンセルボタン　休憩をパスする
 Else
  MsgBox shMane.Cells(12, 4), vbOKOnly, shMane.Cells(12, 2)
 End If
 
End Sub
```