[ExcelVBA] PCロックの妨害

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] ExcelVBA ALL >[ExcelVBA] AdventCalendar

アドベントカレンダー 11日目

コンプラの関係で離席する時は、パソコンにロックをしなさいと口うるさくなる今日この頃。
一定の操作がないとするロックがかかるような設定になったりとコンプラさまさまなわけですが…

ときおり、一部の人だけコードが動かないなんてことがおきるもんだから
その人の環境で調査するため、ログインされた状態で引き渡してもらうのですが
上記理由から、すぐにロックがかかったりするわけですよね。
もちろん、システムなんていじれないようにされてるので、
そうなると、なんかのキーを送信すりゃいいじゃん！
となるのでこうなった。

Option Explicit

Sub SampleCode()
    Dim WSH As Object
    Set WSH = CreateObject("Wscript.Shell")
    
    Do
        WSH.SendKeys "^"
        DoEvents
    Loop
    
    Set WSH = Nothing
End Sub

ひとまず、Ctrlを送信。
これだけでも、十分なんだけど、
これだと、実行しているのか止まっているのか不明なので
もうちょっと視認性を高めるとして、オートシェイプを追加して…
ボタンでスタート/ストップできるようにしてみると。

Option Explicit
Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)

Dim Flag As Boolean
Sub ToggleButton()
    Dim ToggleName As String
    ToggleName = Shapes("Button").TextFrame.Characters.Text
    
    If ToggleName = "スタート" Then
        Shapes("Button").TextFrame.Characters.Text = "ストップ"
        Flag = False
        Call Loooooop
    Else
        Shapes("Button").TextFrame.Characters.Text = "スタート"
        Flag = True
    End If
End Sub


Sub Loooooop()
    Dim WSH As Object

    '** Objectの生成 **
    Set WSH = CreateObject("Wscript.Shell")

    Flag = False

    Do
        If Flag Then Exit Do
        WSH.SendKeys "^"
        Range("B1") = Time
        DoEvents
        Sleep (100)
    Loop
    
    Set WSH = Nothing
    MsgBox "停止"
End Sub

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] ExcelVBA ALL >[ExcelVBA] AdventCalendar