[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『Application.OnTimeエクセルAlarm時計』（マリオ）
エクセルで、アラーム作成していたら、よくわからなくなりました。 ご教授願います。
下記の「Excel_Alarm」プロシージャと 「MSG表示()」の２箇所を修正しないといけないようです。
■B列の時刻になったら、A列のメッセージを表示したい。 例えば、現在時刻が、15時00分だとして、 B3に「15時30分」、B4に「15時01分」が入っていた場合、 「15時01分」が実行されない。「15時30分」を優先的に処理 しようとしているため。 また、B列の時刻が降順（上の方が古い時刻）の場合、 上から順にAlarmが実行されるが、メッセージ表示が、 A3の起きろのメッセージしか表示されない。
■メッセージ表示のとき、 Alarmに設定した時刻(B列の値）も表示したい
■Application.OnTimeについて、変数を渡すやり方がよくわからない
参考にしたサイト http://excel-ubara.com/excelvba5/EXCEL104.html ********************************************************* (1)拡張子xls（Excel 97-2003ブック）でエクセルを保存 (2)Alt+F11で、VBE起動 (3)ThisWorkbook上で、右クリックして、挿入より、 ユーザーフォーム追加（UserForm1）、 標準モジュール追加（Module1） (4)ツールボックスを表示 表示を押して表示されるリストから、ツールボックスを選択 (5)ツールボックスにある「ToggleButton1」と「Label1」を UserForm1に、適当な所に作成 ----------------------------------------------------------------- (6)Sheet1に、次のﾃﾞｰﾀを書き込む Ｂ３の表示形式（yyyy/mm/dd hh:mm:ss） C3,D3,E3の表示形式(00)
|[A] |[B] |[C]|[D]|[E]
[1]| | | | |
[2]|メッセージ|Alarm |時 |分 |秒
[3]|起きろ |=TODAY()+TIME(C3,D3,E3)| 7| 0| 0
[4]|寝ろ |=TODAY()+TIME(C4,D4,E4)| 23| 30| 0
-----------------------------------------------------------------
(7)ThisWorkbookに次のコードを貼り付け
*******************************
Private Sub Workbook_Open()
Call UserForm表示
End Sub
*******************************
-----------------------------------------------------------------
(8)UserForm1の上での右クリックで表示されるメニューから、
「コードの表示」を選択して、次のコードを貼り付け
*******************************************
Private Sub ToggleButton1_Click()
If Me.ToggleButton1.Value = True Then
Application.Visible = False
ToggleButton1.Caption = "Show"
Else
Application.Visible = True
ToggleButton1.Caption = "Hide"
End If
End Sub
*******************************************
----------------------------------------------------------------- (9)Module1に、次のコードを貼り付け ***************************************************************** 'API(外部プログラムを使わずにサウンドを再生) Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _ (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _ ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Sub UserForm表示()
Dim sh As Worksheet, fr As Integer
Set sh = ThisWorkbook.Sheets("Sheet1")
fr = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row - 2
Set sh = Nothing
With UserForm1
.Show vbModeless
.Caption = "Excel_Alarm"
.Height = 55 + fr * 15
.Width = 115
.Top = 0
.Left = 0
End With
With UserForm1.ToggleButton1
.Caption = "Hide"
.Height = 20
.Width = 40
.Top = 5
.Left = 5
End With
With UserForm1.Label1
.Height = fr * 15
.Width = 115
.Top = 30
.Left = 5
.Font.Size = 11
.Font.Name = "Meiryo UI"
End With
Call label_1
Call Excel_Alarm
End Sub
Sub label_1()
Dim msg As String
Dim i As Integer, sh As Worksheet, fr As Integer
Set sh = ThisWorkbook.Sheets("Sheet1")
fr = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
For i = 3 To fr
If sh.Cells(i, 1) <> "" And sh.Cells(i, 2) <> "" Then
If sh.Cells(i, 2) >= Now Then
msg = msg & Format(sh.Cells(i, 2), "mm/dd HH:MM:SS") & " ☆" & vbCr
Else
msg = msg & Format(sh.Cells(i, 2), "mm/dd HH:MM:SS") & " ★" & vbCr
End If
End If
Next
Set sh = Nothing
UserForm1.Label1.Caption = msg
End Sub
Sub Excel_Alarm()
'MsgBox "起動確認"
Dim i As Integer, sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet1")
On Error Resume Next
For i = 3 To sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
If sh.Cells(i, 1) <> "" And sh.Cells(i, 2) <> "" Then
If sh.Cells(i, 2) >= Now Then '★現在時刻以降なら
Application.OnTime sh.Cells(i, 2), "MSG表示"
Exit For
End If
End If
Next
Set sh = Nothing
End Sub
Private Sub MSG表示()
Dim i As Integer, j As Integer, sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet1")
On Error Resume Next
For i = 3 To sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
If sh.Cells(i, 1) <> "" And sh.Cells(i, 2) <> "" Then
If sh.Cells(i, 2) <= Now Then
Beep
'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓
'Dim SoundFile As String, xx As Integer
'SoundFile = "\alarm.wav" '同一ディレクトリにファイルを置いておく
'xx = mciSendString("Play " & SoundFile, "", 0, 0)
'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓
MsgBox (sh.Cells(i, 1))
Call label_1
Exit For
End If
End If
Next
Call Excel_Alarm
Set sh = Nothing
End Sub
*****************************************************************
-----------------------------------------------------------------
(10)Sheet1に、開発タブの挿入より、
フォームコントロールのボタンを貼り付け
ボタン上で、右クリックして、
マクロの登録（UsrForm表示を選択してＯＫ）
＜ 使用 Excel：Excel2013、使用 OS：Windows10 ＞
＞ ■B列の時刻になったら、A列のメッセージを表示したい。 ＞ 例えば、現在時刻が、15時00分だとして、 ＞ B3に「15時30分」、B4に「15時01分」が入っていた場合、 ＞ 「15時01分」が実行されない。「15時30分」を優先的に処理 ＞ しようとしているため。 ＞ また、B列の時刻が降順（上の方が古い時刻）の場合、 ＞ 上から順にAlarmが実行されるが、メッセージ表示が、 ＞ A3の起きろのメッセージしか表示されない。
ソートしておけば良いのでは？
あと、「A列のメッセージを表示したい」「A列しか表示されない」というのは、書いたとおりに動いている、としか…。
＞ ■メッセージ表示のとき、 ＞ Alarmに設定した時刻(B列の値）も表示したい
文字列連結は、&。
＞ ■Application.OnTimeについて、変数を渡すやり方がよくわからない
参考サイト同様、日付と時刻になってますか？ 時刻だけだと、1900年になっちゃいますよ？
その他：
悪いことは言わないので、On Error 命令は、使用を止めなさい。
（???） 2017/01/25(水) 16:45
>（???）さん >ソートしておけば良いのでは？ そうですね。そうしてみました。
>文字列連結は、&。 Application.OnTimeのProcedureのところが、うまくいきません。
>悪いことは言わないので、On Error 命令は、使用を止めなさい。 はい。 _ _ _ 下記のｺｰﾄﾞについて、ご教授願います。
主の【test】プロシージャの★★★★★★の箇所で、Application.OnTimeを使用して、 サブの【MSG_test】プロシージャで指定時刻にメッセージを表示させるコードですが、 次の２つをサブの【MSG_test】プロシージャに渡すやり方がよくわかりません。 ■メッセージが入力されているセル→■sh.Cells(3, 1) ■指定時刻が入力されているセル→■sh.Cells(3, 2)
下記のコードの▲▲▲▲▲箇所が３つありますが、コメントアウトしている箇所と、 それぞれ入れ替えた後に、【test】プロシージャを実行すると、次のエラーが出てしまいます。 '***************************************************************************** マクロ ''C:\■.xls'!'MSG_test 起きろ,2017/01/26 7:50:01'' を実行できません。 このブックでマクロが使用できないか、 またはすべてのマクロが無効になっている可能性があります。 '*****************************************************************************
'↓ココが間違ってるんでしょうか？？？
'x = "'MSG_test " & sh.Cells(3, 1) & "," & sh.Cells(3, 2) & "'"
_
_
_
(1)●Sheet2に次を記述
'-------------------------------------------------------------------
|[A] |[B] |[C]|[D]|[E]
[1]| | | | |
[2]|メッセージ|Alarm 時刻 |時 |分 |秒
[3]|起きろ |=TODAY()+TIME(C3,D3,E3)| 7| 36| 1
(2)●Module1に次を記述
'-------------------------------------------------------------------
Sub test()
Dim sh As Worksheet, x As String
Set sh = ThisWorkbook.Sheets("Sheet2")
If sh.Cells(3, 2) > Now Then '現在時刻以降なら
MsgBox sh.Cells(3, 2) & vbCr & "アラーム設定しました"
x = "'MSG_test'"'▲▲▲▲▲
'x = "'MSG_test " & sh.Cells(3, 1) & "," & sh.Cells(3, 2) & "'"
Application.OnTime EarliestTime:=sh.Cells(3, 2), Procedure:=x'★★★★★★
End If
Set sh = Nothing
End Sub
'-------------------------------------------------------------------
Private Sub MSG_test()'▲▲▲▲▲
'Private Sub MSG_test(Alarm_msg As String, Alarm_Time As String)
Dim sh As Worksheet, rc As Integer
Set sh = ThisWorkbook.Sheets("Sheet2")
Beep
rc = MsgBox("a", vbOKOnly, "b")'▲▲▲▲▲
'rc = MsgBox(Alarm_Time, vbOKOnly, Alarm_msg)
Call test
Set sh = Nothing
End Sub
'------------------------------------------------------------------- (3)●Sheet2のC3,D3,E3に現在時刻より先の時刻を入力してtestプロシージャを実行 （マリオ） 2017/01/26(木) 08:03
トピの内容は、コードも含めてみていないのですが、OnTime の引数のことにふれられていましたので。 先刻ご承知のことなんだと思いますが、自分自身の整理もかねてメモ。
時刻,プロシジャ名を指定する文字列
基本はこうですね。
で、第２引数として そのプロシジャに引数を渡す場合、
・まず、この文字列の先頭と最後に ' (シングルクォーテーション) を入れる ・この文字列の プロシジャ名とそのあとの引数の間には半角スペースを入れる ・引数が複数あれば、引数,引数,引数 と、 ,(カンマ)連結をする ・『文字列』なので、引数として変数を指定することはできない。あくまで変数の『中身』をセット。
こう整理すると、OnTime云々の話ではなく単純に、固定値と変数を連結した『文字列作成』のテーマになりますね。
たとえば 与えるべき文字列が 'ProcA "abc",123,"def"' だった場合、
Sub Test1()
Application.OnTime Now(), "'ProcA ""abc"",123,""def""'"
End Sub
Sub Test2()
Dim s1 As String
Dim s2 As String
Dim n As Long
s1 = "abc"
s2 = "def"
n = 123
Application.OnTime Now(), "'ProcA """ & s1 & """," & n & ",""" & s2 & """'"
End Sub
Sub ProcA(x As String, y As Long, z As String)
MsgBox x & vbLf & y & vbLf & z
End Sub
（β） 2017/01/26(木) 08:32
Public Alarm_Time As Date Public Alarm_msg As String
Sub test()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet2")
If sh.Cells(3, 2) > Now Then
If MsgBox(sh.Cells(3, 2) & vbCr & "アラーム設定します", vbOKCancel Or vbExclamation, "開始確認") = vbOK Then
Alarm_Time = sh.Cells(3, 2)
Alarm_msg = "MSG_test " & sh.Cells(3, 1) & "," & sh.Cells(3, 2)
Application.OnTime Alarm_Time, "MSG_test"
End If
End If
Set sh = Nothing
End Sub
Private Sub MSG_test()
Beep
MsgBox Alarm_msg, vbOKOnly Or vbInformation, "アラーム"
End Sub
現在は実験コードと思うので、こんな感じ。 実際に使用する場合は、以下を検討しましょう。
・アラーム後、Call test しても、シートに書いてある時間は変わっていないので、同じ日時を指定してしまうのでは？（つまり、2度目のOnTimeは発生しない）
・test プロシジャでMsgBox表示すると、そこで入力待ちになって、その先は実行しないので、自動処理にするとここで止まってしまう。
（???） 2017/01/26(木) 09:27
>>OnTime には、引数を指定する機能はないので
えっ？ 指定できますよね？ サンプルとして （β） 2017/01/26(木) 08:32 でコメントしたんですが。
（β） 2017/01/26(木) 09:30
＞参考サイト同様、日付と時刻になってますか？ ＞時刻だけだと、1900年になっちゃいますよ？
本題じゃないですけど、それって本当なんでしょうか。。
常々不思議に思っているんですが、経験上、時刻だけで動いてくれちゃいます。 時刻だけの時は、自動的に「本日」を補ってくれてるっぽい。
Sub setTimer()
Dim TmToSet As Date
TmToSet = Time + TimeValue("00:00:01") '1秒後に起動（Timeだけは無効。過去扱いになる？）
Debug.Print Format(TmToSet, "yyyy/mm/dd hh:nn")
Application.OnTime TmToSet, "'my_Procedure3 ""テストです→"",""" & TmToSet & """'"
End Sub
Sub my_Procedure3(ByVal strMsg, ByVal strTime)
MsgBox strMsg & strTime
End Sub
※βさんのコメントを参考に引数も入れてみました。 かなり面倒な文字列操作ですね。 頭では理解できても、実際にやってみるとエラーの連続(とほほ）
（半平太） 2017/01/26(木) 10:08
>βさん
ありがとうございます。できました。 やりたいことは、文字列を２つ渡すなので、下記のtest3で できました。問題は、違うところにありました。 上記の私のｺｰﾄﾞで、 Private Sub MSG_test()'▲▲▲▲▲ となっているところのPrivateを削除したらＯＫでした。
**************************************************************
Sub Test3()
Dim s1 As String
Dim s2 As String
s1 = Sheets("Sheet1").Cells(3, 1).Value
s2 = Sheets("Sheet1").Cells(3, 2).Value
Application.OnTime Now(), "'ProcA """ & s1 & """,""" & s2 & """'"
End Sub
**************************************************************
（マリオ） 2017/01/26(木) 10:21
>>使いにくい…。
全く同感です。
Application.Run の場合は、素直に プロシジャ名 や 各引数 を それぞれ独立した引数として 列挙すればいいのですが OnTime の場合は、それらをひっくるめて１つの文字列にしなければいけないというのが 面倒ですよね。
（β） 2017/01/26(木) 11:42
>???さん【2017/01/26(木) 09:27 】 >パブリック変数で受け渡してはどうでしょうか。 Application.OnTimeの予約を★解除することを考えると、パブリック変数を使用する方が 分かりやすいと思いました。ご提案ありがとうございました。 OnTimeの予約時刻は、OnTimeの解除を考えると、予約時刻をどこかのシートのセルに書き込んでいた方が、いいですね。 解除するときは、そのセルの値を読み込めばいいですからね。
参考にしたサイト 【やむえむのExcel VBAメモ】 http://yumem.cocolog-nifty.com/excelvba/2011/05/ontime-f016.html
>test プロシジャでMsgBox表示すると、そこで入力待ちになって、 >その先は実行しないので、自動処理にするとここで止まってしまう。 Application.OnTimeの処理を、いくつかの予約時刻で繰り返したいときは、 msgBoxではなく、独自のForm2,Form3のLabelに表示するようにしようと思います。
■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ 下記のコードは、プログラム実行後に、まずOnTime予約されていたら解除して、 その後で、OnTime予約をする例を示したものです。 【Sheet1】(シート名)と【記録】(シート名)を用意して、 下記のｺｰﾄﾞをModule1にコピペして、【Sub サンプル値を入れてから起動()】を実行してください。 実行してから、5秒後に【Alarm設定時刻になりました】のMsgBoxが表示されます
Option Explicit Public Alarm_msg As String '★Public変数 Public Alarm_Time As String '★Public変数
Sub サンプル値を入れてから起動()
ThisWorkbook.Sheets("記録").Range("A4") = "Application.OnTimeの記録 "
Dim sh As Worksheet, now_time As Date
Set sh = ThisWorkbook.Sheets("Sheet1")
Dim X As Date, t As Integer, Y As String
now_time = Now
t = 5 '★今から、5秒後
X = DateAdd("s", t, now_time)
Y = Right(Replace(CStr(X), ":", ""), 6)
Y = Replace(Y, " ", "0")
sh.Cells(2, 1) = "メッセージ"
sh.Cells(2, 2) = "時"
sh.Cells(2, 3) = "分"
sh.Cells(2, 4) = "秒"
sh.Cells(2, 5) = "Alarm 時刻"
sh.Cells(3, 1) = "Alarm設定時刻になりました"
sh.Cells(3, 2) = Mid(Y, 1, 2)
sh.Cells(3, 3) = Mid(Y, 3, 2)
sh.Cells(3, 4) = Mid(Y, 5, 2)
sh.Cells(3, 5).FormulaR1C1 = _
"=IF(AND(RC[-3]<>"""",RC[-2]<>"""",RC[-1]<>""""),TIME(RC[-3],RC[-2],RC[-1]),"""")"
sh.Cells(3, 5).NumberFormatLocal = "hh:mm:ss"
Set sh = Nothing
Call 起動
End Sub
Sub 起動()
'------- 初期化設定(OnTime予約されていたら解除する) ---------------
Dim sh2 As Worksheet: Set sh2 = ThisWorkbook.Sheets("記録")
If IsDate(sh2.Range("B4")) Then
On Error Resume Next 'OnTime予約されていないときに、解除するとエラーになる為
Application.OnTime sh2.Range("B4").Value, "MSG表示", , False '★Alarm予約を解除
On Error GoTo 0
End If
sh2.Range("B4").ClearContents: Set sh2 = Nothing
'------- 次の日の00:00:01に再起動(次の日のDateを取得する為） -------
Application.OnTime Date + 1 + TimeValue("00:00:01"), "起動"
'-------------------------------------------------------------------
Call アラーム
End Sub
Private Sub アラーム()
Dim sh As Worksheet: Set sh = ThisWorkbook.Sheets("Sheet1")
Dim sh2 As Worksheet: Set sh2 = ThisWorkbook.Sheets("記録")
If Date + sh.Cells(3, 5) > Now Then
Alarm_msg = sh.Cells(3, 1).Value '★Public変数
Alarm_Time = Date + sh.Cells(3, 5).Value '★Public変数
Application.OnTime Alarm_Time, "MSG表示"
sh2.Range("B4").Value = Alarm_Time '★記録シートにAlarm予定時刻を書き込む
Else
MsgBox "現在時刻より前の時刻です"
End If
Set sh = Nothing: Set sh2 = Nothing
End Sub
Sub MSG表示()
Dim rc As Integer
rc = MsgBox(Alarm_msg, vbOKOnly, Alarm_Time)
End Sub
（マリオ） 2017/01/30(月) 13:33
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.