アプリ版:「スタンプのみでお礼する」機能のリリースについて

以前にKenken SPさんが作成したマクロを勝手にコピーして使わさせて頂いてますが、タイムマクロ内にタイムマクロを稼働させる事は可能ですか?
Sub 実行予約()  は正常に稼働し Sub 自動マクロ() を実行してます。
指定時刻8時1分と15時1分に自動印刷したいのですがうまく実行しません。
教えて頂けませんか?

Dim mcolTask As Collection

Sub 実行予約()

Dim i As Date
Dim strProcName As String
Dim datBigin As Date
Dim datEnd As Date
Dim datInterval As Date
Dim datTimeout As Date
Dim blnJustTime As Boolean

' Setting-------------------------------------------------------

datBigin = TimeValue("03:33:00") ' 開始時刻
datEnd = TimeValue("23:59:00") ' 終了時刻
datInterval = TimeValue("00:06:00") ' 実行間隔(少なくとも数秒以上で)
datTimeout = TimeValue("00:00:10") ' 実行待機タイムアウト
blnJustTime = True ' datInterval で丸めるか
strProcName = "自動マクロ" ' 実行するマクロ名

'---------------------------------------------------------------

' 既に実行予約されているか確認
If mcolTask Is Nothing Then

' 日付シリアル値を加算
datBigin = datBigin + Date
datEnd = datEnd + Date
' 終了時刻が開始時刻より小さければ日をまたぐので補正
If datEnd < datBigin Then datEnd = datEnd + 1
' 現在時刻が既に終了時刻を過ぎている場合
If datEnd < Now() Then
MsgBox "終了時刻を過ぎているため予約できません。", vbCritical, "終了"
Exit Sub
End If
' 現在時刻が開始時刻を過ぎていれば補正
If datBigin < Now() Then
' 開始時刻を datInterval で指定された値で丸めるか
If blnJustTime Then
datBigin = Application.Floor(Now() + datInterval, datInterval)
Else
datBigin = Now() + datInterval
End If
End If

' 初期化
Set mcolTask = New Collection

' メイン部分
For i = datBigin To datEnd Step datInterval
' 後から取り消せるようにコレクションに退避
mcolTask.Add CStr(i) & "," & strProcName
' Application.Ontime で実行予約を行う
Application.OnTime EarliestTime:=i, _
Procedure:=strProcName, _
LatestTime:=i + datTimeout, _
Schedule:=True
Next i
Else
MsgBox "既に実行中です", vbInformation
End If

End Sub

Sub 未実行予約強制解除()

Dim i As Long
Dim vntS As Variant

On Error Resume Next
Application.StatusBar = "タスク破棄中... "
For i = 1 To mcolTask.Count
vntS = Split(mcolTask.Item(i), ",")
Application.OnTime CDate(vntS(0)), CStr(vntS(1)), Schedule:=False
Next i
Application.StatusBar = ""
Set mcolTask = Nothing

End Sub

' タスク管理用
Private Sub RemoveTask()

On Error Resume Next
mcolTask.Remove (1)
Application.StatusBar = "待機中のタスク... " & mcolTask.Count
DoEvents
Beep
If mcolTask.Count = 0 Then
Application.StatusBar = ""
Set mcolTask = Nothing
End If

End Sub

Sub Auto_Close()

Dim intRes As Integer
If Not mcolTask Is Nothing Then
intRes = MsgBox( _
Prompt:="待機中のタスクが " & mcolTask.Count & " 件あります。" & vbLf _
& "破棄して終了しますか?", _
Buttons:=vbOKCancel + vbDefaultButton2 + vbExclamation, _
Title:="問い合わせ")
If intRes = vbOK Then
Call 未実行予約強制解除
Else
' ブッククローズをキャンセル
Application.ExecuteExcel4Macro ("Halt(True)")
End If
End If
Call 指定時刻8時に印刷する
Call 指定時刻15時に印刷する
End Sub

' 呼び出すマクロ--> Application.Ontime のマクロ名と一致させて下さい

Sub 自動マクロ()
'
自動マクロ Macro
省略
End Sub

Sub 指定時刻8時に印刷する()
Application.OnTime TimeValue("08:01:00"), _
'
Sheets("グラフ1").Select
ActiveWindow.SmallScroll Down:=-12
Range("AE2:AG2").Select
ActiveWindow.SmallScroll Down:=-12
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
End Sub

A 回答 (1件)

こんにちは。


KenKen SPさんのテクニックは、よく覚えています。特に、このスケジュールの中止命令について、この方の書いたテクニックで覚えました。今では、このテクニックは、自分のものになっているのですが、この方が先に使っていたのを思い出しました。

今、そのコード自体は細かくみていませんが、
>指定時刻8時1分と15時1分に自動印刷したいのですがうまく実行しません。
このコードですと、ずっとExcelを開けておかなくてはなりませんが、私のやり方は、1年後先でも、Excelをアンインストールしなければ、実行を可能にします。

私なら、大幅に、そのコードを書き換えて、VBAのTimer メソッドでするよりも、コマンドプロンプト側のschtasks に設定させればよいと思います。
ただ、実際の実行マクロなのですが、オートメーション・オブジェクトにして、本体のExcelとは別に起動させたほうが安全です。仮に、Excelで作業をしていても、別に起動し、別に印刷してくれます。

以下、schtaks のオプションを、
/ST 08:01
/ST 15:01
とすればよいと思います。

以下を参考にしてみてください。
http://oshiete.goo.ne.jp/qa/10099183.html
#3は、動作確認済です。今回の内容には修正する部分も多くあるかとは思いますが、参考になるはずです。なお、解除方法が書いていないのは、コンパネからタスクのスケジュールで取り消しが可能だからです。
    • good
    • 1

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!