Excel VBAでスクリーンセーバ解除

スクリーンセーバを設定している時に、時々画面を確認する必要がある場合にちょこっとVBAで設定

下記URLから引用して省電力モードに対応したよん

http://hanatyan.sakura.ne.jp/vbhlp/SaverOff.htmより引用

スクリーンセーバが起動中か判定する為のものが

SPI_GETSCREENSAVERRUNNING

しかし省電力モードが起動中か判定する為のものがない

SPI_GETLOWPOWERRUNNING　見たいなものがあればいいのに

無いので仕方なく

SystemParametersInfo SPI_SETLOWPOWERACTIVE, 0, Dummy, False

これで省電力モードを一旦無効にして少し待ってから

SystemParametersInfo SPI_SETLOWPOWERACTIVE, 1, Dummy, False

再度これで省電力モードを有効へと手抜き処理

Excelのセルにスクリーンセーバの解除する時間を設定して開始ボタンを押す

ストップする時に即、停止させたい為これもセル内にステータスを用意

 

'
' Macro1 Macro
' マクロ記録日 : 2010/2/14  ユーザー名 : kojin
'
'http://hanatyan.sakura.ne.jp/vbhlp/SaverOff.htmより引用
Option Explicit     'SampleNo=070　WindowsXP VB6.0(SP5) 2002.05.16
'マウスのカーソル位置を設定する　(389)
Private Declare Function SetCursorPos Lib "user32" _
    (ByVal x As Integer, ByVal y As Integer) As Long
'現在のマウスカーソルの位置座標を取得する（P387)
Private Declare Function GetCursorPos Lib "user32" _
    (lpPoint As MoPoint) As Long
'システム全体に関するパラメータを取得・設定する(P928)
Private Declare Function SystemParametersInfo Lib "user32.dll" _
    Alias "SystemParametersInfoA" _
    (ByVal uiAction As Long, ByVal uiParam As Long, _
    pvParam As Any, ByVal fWinIni As Long) As Long
'指定のウインドウにメッセージを送る(P750)
Private Declare Function SendMessage Lib "user32" _
    Alias "SendMessageA" (ByVal hWnd As Long, _
    ByVal wMsg As Long, ByVal wParam As Long, _
    lParam As Any) As Long

'スクリーンセーバーが起動中かを取得する定数
Private Const SPI_GETSCREENSAVERRUNNING = 114
'システムメニューが操作された時、そのウインドウに送られるメッセージ (P889)
Private Const WM_SYSCOMMAND = &H112
'省電力モードが有効かを取得する定数
Private Const SPI_GETLOWPOWERACTIVE = 83
'省電力モードが有効／無効に設定する定数
Private Const SPI_SETLOWPOWERACTIVE = 85

'スクリーンセーバを起動する　(P889)
Private Const SC_SCREENSAVE = &HF140&    '後ろに必ず　& を付ける事

'ポインターのX座標とY座標を定義する構造体
Private Type MoPoint
    x As Long
    y As Long
End Type
Private x1 As Long
Private y1 As Long
Private MoP As MoPoint
Private Sub sSaverOff()
    '現在の位置を保存（保存せずに移動するだけでもOKだが）
    GetCursorPos MoP
    x1 = MoP.x
    y1 = MoP.y
    MoP.x = 0
    MoP.y = 0
    'マウスポインターを左上に移動（セーバー停止）
    SetCursorPos MoP.x, MoP.y
    '移動が終了するのを待って元の位置に戻す
    DoEvents  'これをいれておかないと動いたことにならないので
    MoP.x = x1
    MoP.y = y1
    'マウスポインターを元の位置に戻す
    SetCursorPos MoP.x, MoP.y
    DoEvents
End Sub
Private Sub StopTime(st)
'タイマー関数を使って Sleep 関数と同様の関数を作成
    Dim sngSt As Single
    Dim State As String
    sngSt = Timer
    Do While Timer - sngSt < st
     DoEvents
     State = Range("B8")
     If State = "stop" Then
        Exit Sub
    End If
    Loop
End Sub
'Sub Auto_Open() '自動起動の場合はこの名前にする
Sub ScreenSaverOff()
    'スクリーンセーバの起動を待って
    Dim BoolSaverOn As Boolean
    Dim BoolLowPowerOn As Boolean
    Dim Dummy As Long
    Dim Min As Long
    Dim State As String
    Worksheets("Sheet1").Activate
    Range("B8").Select
    ActiveCell.FormulaR1C1 = "run"
    Do
    Min = Range("B3") * 60
    State = Range("B8")
    If State = "stop" Then
       MsgBox "スクリーンセーバ解除処理を停止しました"
       Exit Sub
    End If
    StopTime Min '指定秒待つ
    'スクリーンセーバーが起動中かを調べる
    SystemParametersInfo SPI_GETSCREENSAVERRUNNING, 0, BoolSaverOn, False
    If BoolSaverOn Then
        sSaverOff
    End If
    '省電力モードが有効かを調べる
    SystemParametersInfo SPI_GETLOWPOWERACTIVE, 0, BoolLowPowerOn, False
    If BoolLowPowerOn Then
      '省電力モードを一時的に無効
        SystemParametersInfo SPI_SETLOWPOWERACTIVE, 0, Dummy, False
        StopTime 10
      '省電力モードを有効
        SystemParametersInfo SPI_SETLOWPOWERACTIVE, 1, Dummy, False
    End If
    Loop
End Sub
Sub stop_program()
'
' Macro2 Macro
' マクロ記録日 : 2010/2/25  ユーザー名 :
    Range("B8").Select
    ActiveCell.FormulaR1C1 = "stop"
End Sub

pepoと