[ExcelVBA] PCロックの妨害

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

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

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

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

view plainprint?

1. Option Explicit  
2.   
3. Sub SampleCode()  
4.     Dim WSH As Object  
5.     Set WSH = CreateObject("Wscript.Shell")  
6.       
7.     Do  
8.         WSH.SendKeys "^"  
9.         DoEvents  
10.     Loop  
11.       
12.     Set WSH = Nothing  
13. End Sub  

Option Explicit

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

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

view plainprint?

1. Option Explicit  
2. Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)  
3.   
4. Dim Flag As Boolean  
5. Sub ToggleButton()  
6.     Dim ToggleName As String  
7.     ToggleName = Shapes("Button").TextFrame.Characters.Text  
8.       
9.     If ToggleName = "スタート" Then  
10.         Shapes("Button").TextFrame.Characters.Text = "ストップ"  
11.         Flag = False  
12.         Call Loooooop  
13.     Else  
14.         Shapes("Button").TextFrame.Characters.Text = "スタート"  
15.         Flag = True  
16.     End If  
17. End Sub  
18.   
19.   
20. Sub Loooooop()  
21.     Dim WSH As Object  
22.   
23.     '** Objectの生成 **  
24.     Set WSH = CreateObject("Wscript.Shell")  
25.   
26.     Flag = False  
27.   
28.     Do  
29.         If Flag Then Exit Do  
30.         WSH.SendKeys "^"  
31.         Range("B1") = Time  
32.         DoEvents  
33.         Sleep (100)  
34.     Loop  
35.       
36.     Set WSH = Nothing  
37.     MsgBox "停止"  
38. End Sub  

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