如何使用VBA从64位Windows Vista调用ActivateKeyboardLayout

Question

在XP下运行VBA我能够调用ActivateKeyboardLayout将我的输入语言从英语切换到另一种语言。但是，这不再适用于Vista64。

任何建议或解决方法？

所使用XP下工作的代码是类似以下内容：

Private Declare Function ActivateKeyboardLayout Lib "user32" (_ 
    ByVal HKL As Long, ByVal flags As Integer) As Integer 
Const aklPUNJABI As Long = &H4460446 
ActivateKeyboardLayout aklPUNJABI, 0 

有人建议尝试

Public Declare Function ActivateKeyboardLayout Lib "user32" (_ 
    ByVal nkl As IntPtr, ByVal Flags As uint) As Integer 

当我尝试这个，我得到的错误信息：

变量使用Visual Basic不支持的自动化类型

Answer 1

您对ActivateKeyboardLayout的声明实际上是不正确的。对于32位系统，你的代码应该是这样的：

Private Declare Function ActivateKeyboardLayout Lib "user32" (ByVal HKL As Long, _ 
    ByVal flags As Long) As Long 

Const aklPUNJABI As Long = &H4460446 
Dim oldLayout as Long 
oldLayout = ActivateKeyboardLayout(aklPUNJABI, 0) 
If oldLayout = 0 Then 
    'Oops an error' 
Else 
    'Save old layout for later restore?' 
End If 

操作系统的64位处理是有点在这种情况下，一个红色的鲱鱼。由于您运行的是VBA应用程序，因此无论操作系统如何，它都必须以32位应用程序的形式运行。我怀疑你的问题可能是你的Vista系统上你想要的旁遮普键盘布局没有加载。 ActivateKeyboardLayout只能用于激活已经加载的键盘布局。出于某种原因，此API的设计者认为由于键盘布局不存在而导致的故障不是错误，因此不会设置LastDllError。您可能需要考虑使用LoadKeyboardLayout来处理这种情况。

编辑：要仔细检查你正在试图让键盘布局实际上是加载您可以使用此：

Private Declare Function GetKeyboardLayoutList Lib "user32" (ByVal size As Long, _ 
    ByRef layouts As Long) As Long 

Dim numLayouts As Long 
Dim i As Long 
Dim layouts() As Long 

numLayouts = GetKeyboardLayoutList(0, ByVal 0&) 
ReDim layouts(numLayouts - 1) 
GetKeyboardLayoutList numLayouts, layouts(0) 

Dim msg As String 
msg = "Loaded keyboard layouts: " & vbCrLf & vbCrLf 

For i = 0 To numLayouts - 1 
    msg = msg & Hex(layouts(i)) & vbCrLf 
Next 

MsgBox msg 

Answer 2

这只是一个盲目的猜测，但是您是否曾尝试将您的应用程序作为高级管理员运行，以查看它是否有所作为？什么是GetLastError的错误代码/值？

Answer 3

你有没有尝试.Net line（如VB.Net script或those snippets），如：

InputLanguage.CurrentInputLanguage = 
    InputLanguage.FromCulture(New System.Globalization.CultureInfo("ar-EG")) 

InputLanguage应该支持Vista64上有.Net3.5

VB.Net代码：

Public Sub ChangeInputLanguage(ByVal InputLang As InputLanguage) 
    If InputLanguage.InstalledInputLanguages.IndexOf(InputLang) = -1 Then 
     Throw New ArgumentOutOfRangeException() 
    End If 
    InputLanguage.CurrentInputLanguage = InputLang 
End Sub 

Answer 4

对于64位可移植性，您可能需要使用IntPtr。你能给这个镜头吗？

Public Declare Function ActivateKeyboardLayout Lib "user32" (ByVal nkl As IntPtr, ByVal Flags As uint) As Integer 

Answer 5

，每个人都似乎在这里忽略的事情是，你是在VBA工作，不在.NET中。 IntPtr是一个.NET类型，它表示一个本地平台的整数。在32位平台上，它是32位，在64位平台上是64位。

鉴于HKL是一个句柄的typedef，它是一个用于VOID *的typedef的PVOID类型定义，如果您使用的是.NET，它正是您所需要的。

对于64位数字，VBA没有任何东西，所以你必须采取不同的方法。

在64位机器上，你将不得不做这样的事情：

Public Type HKL64 
    High As Long 
    Low As Long 
End Type 

Private Declare Function ActivateKeyboardLayout Lib "user32" (_ 
    Byval HklHigh As Long, Byval HklLow As Long, _ 
    ByVal flags As Integer) As HKL64 

这应该允许您通过堆栈的API函数（跨两个变量在64位值）。但是，如果您打算在64位和32位计算机上使用此代码，则必须对API进行两次声明，然后确定要调用哪一个。

此外，VBA中调用处理指针或句柄的API的任何其他代码都必须进行相应更改以处理64位输入（而非32位）。

在附注中，ActivateKeyboardLayout的原始声明是错误的，因为它有一个返回类型Integer，它是一个16位值，而API返回一个HKL类型，它是32位或64位，取决于平台。

Answer 6

在Office应用程序的64位版本中，VBA确实是64位版本。有关更改的详细信息，请参见Office 2010 documentation。对于Stephen Martin's answer给出的例子中，你将需要更改代码，如下所示添加PtrSafe属性和修正内容有Win32 API中一个HKL类型的参数：

Private Declare PtrSafe Function ActivateKeyboardLayout Lib "user32" (ByVal HKL As LongPtr, _ 
    ByVal flags As Long) As LongPtr 

Const aklPUNJABI As LongPtr = &H4460446 
Dim oldLayout as LongPtr 
oldLayout = ActivateKeyboardLayout(aklPUNJABI, 0) 
If oldLayout = 0 Then 
    'Oops an error' 
Else 
    'Save old layout for later restore?' 
End If 

和

Private Declare PtrSafe Function GetKeyboardLayoutList Lib "user32" (ByVal size As Long, _ 
    ByRef layouts As LongPtr) As Long 

Dim numLayouts As Long 
Dim i As Long 
Dim layouts() As LongPtr 

numLayouts = GetKeyboardLayoutList(0, ByVal 0&) 
ReDim layouts(numLayouts - 1) 
GetKeyboardLayoutList numLayouts, layouts(0) 

Dim msg As String 
msg = "Loaded keyboard layouts: " & vbCrLf & vbCrLf 

For i = 0 To numLayouts - 1 
    msg = msg & Hex(layouts(i)) & vbCrLf 
Next 

MsgBox msg