はじめに
前回のアドベントカレンダー(クリスマスver.)の時は、参加してみたいけど**"技術"**そんなに詳しくないし…と参加を見送りました。でも完成した冊子を見て「いいなーかっこいいな」と思ったので、今回は思い切って参加してみました。考えてみると意外と案が浮かんできました。**休憩を促すアラームを作る(Excelのマクロで指定時間にダイアログを表示させてみる)**のテーマで記事を書いていきます。
仕様
###【やりたいこと】
####休憩を促すアラームを作る
###+実装の勉強(途中からこっちメイン)
###【最低限】
###【+α】
こんなのを作りました。(実際に作ったもの)
作業記録
####ダイアログを表示する
Msgbox ("さぁでるかな")
####指定の時間にダイアログを表示する
Application.OnTime EarliestTime:=TimeValue("17:45:55"), Procedure:="Breaktime"
上の記述で、指定の時間(17:45:55)にダイアログを表示するメソッド(Breaktime)を実行しています。
時間によって違うメッセージを表示する
'繰り返し処理開始
For i = 2 To 8
'セルの値の時間になったら"Breaktime(i, nowdate)"メソッドを実行する
Application.OnTime EarliestTime:=shMane.Cells(i, 3).Value, Procedure:="'Breaktime " & i & "," & nowDate & "'"
Next i
'ダイアログを出す(メッセージ & (改行して) & 共通質問, ボタンの種類, タイトル)
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
休憩回数(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
休憩を促す内容のダイアログを表示する。
休憩回数の記録を取る
'休憩回数を記録するための処理
Dim nowDate As Integer
nowDate = Day(Date) + 1
'今日の日付の回数に0を設定する
shReco.Cells(2, nowDate).Value = 0
'はいボタン 今休憩とる
If ans = 6 Then
shReco.Cells(2, nowDate).Value = shReco.Cells(2, nowDate).Value + 1
休憩回数に0を設定しておいて、
「はい」ボタンが押されたときは1を加える。
つづき
月末になったら日付と回数をコピーして履歴に貼り付けます。
※履歴は手動で貼り付ける。
ここまでで大体は完成です。
つまづいたところ
課題1 メソッド呼び出しで引数を渡す
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 & "'"と書けば良いみたいです。
課題2 アクティブブックじゃなくなったときのための対処
'シート名管理
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から書いてみて、調べるのも含めて楽しかったです。
とりあえずエントリーしてみるの大事だと思いました。
最後に全コード載せておきます。
'このメソッドを実行する
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
'"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