在宏运行结束时打开NUMLOCK

时间:2017-02-24 14:10:09

标签: excel vba excel-vba

代码的作用:我有一个代码可以在屏幕上移动鼠标,获取打印屏幕并将其粘贴到Excel上。

问题:出于某种原因,我的代码总是(完全没有例外)在每次运行后关闭NUMLOCK键。

到目前为止我尝试了什么:我在周围搜索并找到了SendKeys(NUMLOCK),这在理论上有效(尽管对用户来说似乎很有问题)。

我想做什么:我想在每次宏观运行后打开NUMLOCK,

Obs1:我不知道是什么原因导致宏首先将其关闭。修复造成这种情况的任何事情都是理想的,但由于我不知道问题是什么,我首先要让我的代码功能正常。一旦找到了打开NUMLOCK键的方法,我就会继续努力。

问题:我可以使用SendKeys执行此操作吗?我使用得当吗?还有更好的方法吗?

Obs2:由于它是一个更大的代码,一旦解决了这个问题,我将用整个代码发布另一个问题,并继续讨论造成问题的原因。

代码我试图提起诉讼以打开numlock:

Application.Sendkeys (NUMLOCK)

也尝试过:

Application.Sendkeys ("NUMLOCK")

Application.Sendkeys {NUMLOCK}

5 个答案:

答案 0 :(得分:6)

您可以使用几个Windows API调用直接设置keystate。移植自MSDN page for keybd_event function

#If VBA7 Then
    Private Declare PtrSafe Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, _
                                                              ByVal dwFlags As LongPtr, ByVal dwExtraInfo As LongPtr)
    Private Declare PtrSafe Function GetKeyboardState Lib "user32.dll" (ByVal lpKeyState As LongPtr) As Boolean
#Else
    Private Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, _
                                                      ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    Private Declare Function GetKeyboardState Lib "user32.dll" (ByVal lpKeyState As Long) As Boolean
#End If  

Private Const KEYEVENTF_EXTENDEDKEY As Long = &H1
Private Const KEYEVENTF_KEYUP As Long = &H2
Private Const VK_NUMLOCK As Byte = &H90
Private Const NumLockScanCode As Byte = &H45

Private Sub ToggleNumlock(enabled As Boolean)
    Dim keystate(255) As Byte
    'Test current keyboard state.
    GetKeyboardState (VarPtr(keystate(0)))
    If (Not keystate(VK_NUMLOCK) And enabled) Or (keystate(VK_NUMLOCK) And Not enabled) Then
        'Send a keydown
        keybd_event VK_NUMLOCK, NumLockScanCode, KEYEVENTF_EXTENDEDKEY, 0&
        'Send a keyup
        keybd_event VK_NUMLOCK, NumLockScanCode, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0&
    End If
End Sub

这样称呼:

Sub Example()
    'Turn Numlock off.
    ToggleNumlock False
    'Turn Numlock on.
    ToggleNumlock True
End Sub

答案 1 :(得分:2)

首先,将以下代码复制并粘贴到Excel工作表的模块中(例如:-Module-1)...

Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
       Private Const kCapital = 20
       Private Const kNumlock = 144

       Public Function CapsLock() As Boolean
       CapsLock = KeyState(kCapital)
       End Function

       Public Function NumLock() As Boolean
       NumLock = KeyState(kNumlock)
       End Function

       Private Function KeyState(lKey As Long) As Boolean
       KeyState = CBool(GetKeyState(lKey))
       End Function

然后,在工作表代码中复制并粘贴以下内容(例如: - Sheet1(代码))......

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      Range("XFD1").FormulaR1C1 = "=NumLock()"
      If Range("XFD1").Value = "FALSE" Then
      SendKeys "{NUMLOCK}"
      Else
      End If
      End Sub

现在冷静!对于您进行的每个SelectionChange,Excel刷新自身并确保Numlock始终打开。 如果需要,请更换“Capslock”而不是Numlock,视情况而定。

感谢。 Sashi Elit:)

答案 2 :(得分:0)

到目前为止,我发现此解决方案是最好的,并且不会干扰NUMLOCK。 将下面的代码放入模块中,然后从项目中的任何位置调用它。脚本对象将覆盖VBA中的SendKey。

Public Sub Sendkeys(text as variant, Optional wait As Boolean = False)
   Dim WshShell As Object
   Set WshShell = CreateObject("wscript.shell")
   WshShell.Sendkeys cstr(text), wait
   Set WshShell = Nothing
End Sub 

我在以下线程中找到了它:

SendKeys() permission denied error in Visual Basic

答案 3 :(得分:0)

我尝试了所有建议,直到我注意到它不是 (NUMLOCK) 而是 {NUMLOCK}。这对我有用。

子Numlock() 发送键“{NUMLOCK}” 结束子

答案 4 :(得分:-1)

您几乎拥有了! 正确的编码是: Application.Sendkeys(“ {NUMLOCK}”)