Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

38980 / 76732

←次へ　｜　前へ→


	【42873】１つにできますか？

まーくん - 06/9/24(日) 3:34 -


	引用なし

	パスワード

皆さん　よろしくお願いします。昨日教えていただいた別々の
コードですが１つにできますか？
下記のように修正してみたのですがうまく表示しません。
Case・・・は表示してくれるのですが
時間で表示が出ません　仮に出来なければ１つのbookに
両方のコードを書き込みたいのですができますか？
別々に標準モジュール1.2に
書き込んだのですがエラーが出てしまいます。下記エラー内容
｢名前が適切ではありません Auto_Open｣
[#42832]　[#42863]
よろしくお願いします。
また[#42863]keinさんのコードですが
シートの保護設定が保護の状態ですと
起動しないようなのですが？いかがでしょうか

Sub Auto_Open()
　Dim lowerbound As Integer
　Dim upperbound As Integer
　Dim MyR As Range
　
　lowerbound = 1
　upperbound = 100

'☆追加
　Randomize　　' 乱数発生ルーチンを初期化します。
　Select Case Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
　Case 1 To 10
　　MsgBox "血圧は正常ですか？"
　Case 11 To 20
　　MsgBox "今日のあなたの運勢は○吉です"
　Case 21 To 30
　　MsgBox "今日もお仕事頑張るぞ！"
　Case 31 To 40
　　MsgBox "昨日の夕飯何食べました？"
　Case 41 To 50
　　MsgBox "おとといの朝食はなに？
　Case 51 To 60
　　MsgBox "今日はいくら稼ぎましたか？"
　Case 61 To 70
　　MsgBox "今日は残業無しで帰りましょう。
　Case 71 To 80
　　MsgBox "今日のあなたの運勢は○凶です。
　Case 81 To 90
　　MsgBox "貴方の名前・年齢・血液型は？
　Case 91 To 100
　　MsgBox "お元気ですか・・・？"
　 End Select

　 Set MyR = Worksheets(1).Range("IV1:IV4")
　 With Application
　　　If .Count(MyR) > 0 Then GoTo ELine
　　　If IsEmpty(MyR.Cells(1)) And _
　　　Time < TimeValue("02:48:00") Then
　　　　 .OnTime TimeValue("02:48:00"), "MyScd"
　　　　 MyR.Cells(1).Value = "02:49:00"
　　　End If
　　　If IsEmpty(MyR.Cells(2)) And _
　　　Time < TimeValue("11:55:00") Then
　　　　 .OnTime TimeValue("11:55:00"), "MyScd"
　　　　 MyR.Cells(2).Value = "11:56:00"
　　　End If
　　　If IsEmpty(MyR.Cells(3)) And _
　　　Time < TimeValue("15:00:00") Then
　　　　 .OnTime TimeValue("15:00:00"), "MyScd"
　　　　 MyR.Cells(3).Value = "15:01:00"
　　　End If
　　　If IsEmpty(MyR.Cells(4)) And _
　　　Time < TimeValue("17:00:00") Then
　　　　 .OnTime TimeValue("17:00:00"), "MyScd"
　　　　 MyR.Cells(4).Value = "17:01:00"
　　　End If
　 End With
ELine:
　 Set MyR = Nothing
End Sub

Sub MyScd()
　 Dim WshShell As Object

　 Set WshShell = CreateObject("WScript.Shell")
　 With Worksheets(1)
　　　If Time < .Range("IV1").Value Then
　　　　 WshShell.Popup "休憩時間ですよ", 7, , 64
　　　　 .Range("IV1").Clear
　　　ElseIf Time < .Range("IV2").Value Then
　　　　 WshShell.Popup "そろそろ昼食の時間です", 7, , 64
　　　　 .Range("IV2").Clear
　　　ElseIf Time < .Range("IV3").Value Then
　　　　 WshShell.Popup "お茶の時間ですよ", 7, , 64
　　　　 .Range("IV3").Clear
　　　ElseIf Time < .Range("IV4").Value Then
　　　　 WshShell.Popup "終了時間ですよ", 7, , 64
　　　　 .Range("IV4").Clear
　　　End If
　 End With
　 Set WshShell = Nothing
End Sub

0 hits

▼

【42873】１つにできますか？ まーくん 06/9/24(日) 3:34

≪