I have a few excel projects which utilize userforms. Those userforms have some code which uses Windows API calls to modify their style. An example of this can be found here:
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function DwmSetWindowAttribute Lib "dwmapi" (ByVal hwnd As Long, ByVal attr As Integer, ByRef attrValue As Integer, ByVal attrSize As Integer) As Long
Private Declare PtrSafe Function DwmExtendFrameIntoClientArea Lib "dwmapi" (ByVal hwnd As Long, ByRef NEWMARGINS As MARGINS) As Long
Private UFSHADOW As Long
Private Type MARGINS
leftWidth As Long
rightWidth As Long
topHeight As Long
bottomHeight As Long
End Type
Sub all_userForms_AddShadow(frm As Object)
'Sub adds a shadow
Dim MARGINS As MARGINS
UFSHADOW = FindWindow("ThunderDFrame", vbNullString) 'Create a new Window
DwmSetWindowAttribute UFSHADOW, 2, 2, 4 'DWMAPI
'Determine Margins
With MARGINS
.rightWidth = 1
.leftWidth = 1
.topHeight = 1
.bottomHeight = 1
End With
DwmExtendFrameIntoClientArea UFSHADOW, MARGINS 'DWMAPI
'Resize
frm.Width = frm.Width - 1
frm.Height = frm.Height - 1
End Sub
The issue is that on certain clients, this will compile fine, but the result will not be displayed when the userform is initialized. I believe this is because on some clients, the windows setting "Enable Desktop Composition" is disabled by default and unable to be modified. A workaround I plan on using is to test whether or not Desktop Composition is enabled and if it is not, I will not call the sub.
My issue is that I cannot figure out how to test this. In the remarks section of this link https://msdn.microsoft.com/en-us/library/windows/desktop/aa969524(v=vs.85).aspx describes what should be returned if the DwmSetWindowAttribute function fails: DWM_E_COMPOSITIONDISABLED. I have tried setting this function equal to a few variable types, but it will not work.
Examples:
Desktop Composition Disabled
Desktop Composition Enabled
Any Suggestions? Thanks
Edit: In response to Mat's Mug's questions:
No error is thrown, it simply just does not draw the shadow.
You probably did not get the intended result as there are a few other API functions I call in relation to the "Add Shadow" sub which turn of the window caption and another which turns off the border. I can post those as well, but would make this post quite long.
I am a bit new to using windows API functions, I don't quite know your comments on the IF conditionals and VB Signatures, but I am researching it now..
As far as the bitness go, it's very likely that this tool will be accessed on both 32 and 64 bit OS. update.. I have just tested on both versions, my local machine has 64bit OS, the problem version has 32bit
Related
I created an on click button event, which is supposed to move my popup form to the top left corner of the screen. The function that I used was:
Private Sub Command1_Click()
DoCmd.MoveSize(0 ,0)
End Sub
I noticed that if my popup form is positioned on my second monitor it will send the popup form to the top left corner of my primary monitor.
Is there a way to send the form to the top left corner of whichever monitor the form is being opened in?
I tried a different idea where I will use a function to use the ".Move" property of the form. I came up with this:
Private Sub Command1_Click()
Form.Move(0, 0)
End Sub
This didn't work either, as it seems that the "0, 0" coordinates are relative to wherever the Access Window is positioned on the screen and not the top left corner of the monitor.
Is this a limitation of Access VBA or is it doable using some other technique?
While this seems trivial, unfortunately, it isn't, and we're going to need to use a fair amount of WinAPI. That makes it really hard for beginners.
We need a couple of things:
We need to be able to determine on which monitor the form is
We need to be able to determine where that monitor is in the "virtual screen" (think about positioning monitors relative to eachother)
We need to be able to determine the size of the current window in pixels
We need to be able to position the form on the "virtual screen".
For that, we need a couple of declarations. These are best kept on separate modules, but if you're 100% sure they will only be used on this form, they can go on the form too.
First, the type and value declarations:
'https://learn.microsoft.com/en-us/windows/win32/api/windef/ns-windef-rect
Public Type RECT
left As Long
top As Long
right As Long
bottom As Long
End Type
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-monitorinfo
Public Type MONITORINFO
cbSize As Long
rcMonitor As RECT
rcWork As RECT
dwFlags As Long
End Type
'Either look this one up by Googling, or create a C++ program that references winuser.h and print it
Public Const MONITOR_DEFAULTTONEAREST = &H2
Then, the function declarations:
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-getmonitorinfow
Public Declare PtrSafe Function GetMonitorInfoW Lib "User32.dll" (ByVal hMonitor As LongPtr, ByRef lpmi As MONITORINFO) As Boolean
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-monitorfromwindow
Public Declare PtrSafe Function MonitorFromWindow Lib "User32.dll" (ByVal hWnd As LongPtr, ByVal dwFlags As Long) As LongPtr
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-movewindow
Public Declare PtrSafe Function MoveWindow Lib "User32.dll" (ByVal hWnd As LongPtr, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Boolean) As Boolean
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-getwindowrect
Public Declare PtrSafe Function GetWindowRect Lib "User32.dll" (ByVal hWnd As LongPtr, ByRef lpRect As RECT) As Boolean
And then, on the form, putting it all to work:
Private Sub Command0_Click()
Dim mi As MONITORINFO
Dim monitor As LongPtr
Dim myrect As RECT
'Get the current size and position of the window
GetWindowRect Me.hWnd, myrect
'Determine which monitor it is on
monitor = MonitorFromWindow(Me.hWnd, MONITOR_DEFAULTTONEAREST)
'Make sure WinAPI knows the size of the MONITORINFO struct we're working with
mi.cbSize = LenB(mi)
'Get the monitor info
GetMonitorInfoW monitor, mi
'Move the window to the top right, keep width and height equal to the current values
MoveWindow Me.hWnd, mi.rcMonitor.left, mi.rcMonitor.top, myrect.right - myrect.left, myrect.bottom - myrect.top, True
End Sub
Unfortunately, that's quite a lot more code and more complicated concepts than DoCmd.MoveSize(0 ,0), but I do not know of a simpler approach. VBA doesn't really have any support for multiple monitors, so you'll often have to go to WinAPI to account for them.
I have an application which is designed to run full screen constantly. This works fine normally, however, when things run in the background, for example, an antivirus update this can bring that window above my app. Thats fine because I can use things like:
SetForegroundWindow
ShowWindow
SwitchToThisWindow
All of which allow me to bring my application back to the front. However, inside the application is a hidden text box which when the application loads is focussed. When I use one of the pInvoke calls above whilst the application is brought back to front, the focus is still on the existing application.
I am currently struggling with the best way of giving focus back to the control.
I could use Control.FromHandle but seems fairly complicated to get the controls I need and offer focus if a specific tab page is at the front. Is there a better way, any thoughts / ideas welcome.
I was running this on a Windows 10 LTSB unit and as previously mentioned SetForegroundWindow and Show functions were not working along with many other functions I found on pInvoke. I managed to select the correct process and bring it to the forefront if something else takes its place to the top. The issue was that it would never activate no matter what I tried.
In the end, I implemented the following code which checks every 5 seconds, if my app is not the foremost and not maximised then minimise / maximise the window and this reactivates and refocuses the app:
Public Declare Function FindWindow Lib "user32.dll" (ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
Public Declare Function ShowWindowAsync Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal nCmdShow As Integer) As IntPtr
Private Declare Function GetWindowPlacement Lib "user32.dll" (ByVal hWnd As IntPtr, ByRef lpwndpl As WINDOWPLACEMENT) As Boolean
Private Declare Function GetForegroundWindow Lib "user32.dll" () As IntPtr
<Serializable>
Friend Structure WINDOWPLACEMENT
Public length As Integer
Public flags As Integer
Public showCmd As ShowWindowCommands
Public ptMinPosition As System.Drawing.Point
Public ptMaxPosition As System.Drawing.Point
Public rcNormalPosition As System.Drawing.Rectangle
End Structure
Friend Enum ShowWindowCommands
Hide = 0
Normal = 1
Minimized = 2
Maximized = 3
End Enum
Private Async Function CheckCurrentApp() As Task
Try
' Try and locate the core process
Dim coreHandle = FindWindow(Nothing, "Name of window")
If coreHandle = IntPtr.Zero Then
' Can't find the core. Exit here.
Exit Try
End If
' Get information about the Core window
Dim currentWindowInfo As WINDOWPLACEMENT
GetWindowPlacement(coreHandle, currentWindowInfo)
' If the core is not the foreground window or isn't maximised then send a minimise (6) and maximise (3) request.
' Activate functions in user32 don't work - I spent a day trying to make it so. I could get the foreground window as the core but the input would
' remain in a different application.
If coreHandle <> GetForegroundWindow() OrElse currentWindowInfo.showCmd <> ShowWindowCommands.Maximized Then
ShowWindowAsync(coreHandle, 6)
ShowWindowAsync(coreHandle, 3)
End If
Catch ex As Exception
' DO SOMETHING WITH THE EXCEPTION.
End Try
Await Task.Delay(TimeSpan.FromSeconds(5))
Await CheckCurrentApp()
End Function
I need to be able to list all current Access applications. The GetObject command is well thought out, but it is not very efficient when it comes to simultaneously processing batches of read/write accdb files and ensure that there is only one Access instance per file. I found approaches to my problem in some rare places on the Net and I was actually able to tinker with exactly what I needed.
But my solution has some rather strange and annoying side effects: when I use it, Access instances don't really close but get invisible while keeping applications opened: I can't even make them visible again with .Visible= True, the action just don't work and I must kill them by hand. I have even seen remaining Access instances mixing in the task manager with the Excel instance Workbooks...
The fact is that I have very little knowledge of the Windows APIs that it implements: it's by chance if my solution works.
So I'm asking you here to help me finalize this code that does a simple thing, return a collection of Applications Access objects currently opened.
Here is the code:
Option Explicit
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hWnd As LongPtr, ByVal dwId As Long, riid As UUID, ppvObject As Object) As Long
Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, ByRef lpiid As UUID) As Long
Private Type UUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
Private Const OBJID_NATIVEOM As Long = &HFFFFFFF0
Public Function AccessInstances() As Collection
Dim hWndDesk As LongPtr, hWnd As LongPtr
Dim iid As UUID, obj As Object
Dim acApp As Access.Application
Set AccessInstances = New Collection
hWndDesk = GetDesktopWindow
Do
hWnd = FindWindowEx(hWndDesk, hWnd, "OMain", vbNullString)
Call IIDFromString(StrPtr(IID_IDispatch), iid)
If AccessibleObjectFromWindow(hWnd, OBJID_NATIVEOM, iid, obj) = 0 Then
Set acApp = obj
AccessInstances.Add acApp
End If
Loop Until hWnd = 0
Set acApp = Nothing
End Function
The command that triggers the problems is AccessibleObjectFromWindow. I understand that there is an intermediate FindWindowEx call to do before invoking this command, but I ignore how it must be done, this totally out of my scope.
I thought that the Application Objects reserved by the collection could be what forces the application to stay open, but I never use them in a static or module level private variable, which implies that they are necessarily set to Nothing when the program stops, whether I do it myself explicitly or not, like in this example:
Sub ListAccessInstances()
Dim acApp As Access.Application
For Each acApp In AccessInstances
Debug.Print acApp.Name
Next
End Sub
Edit / additional information :
I was able to highlight the seemingly systematic problem that the function produces.
The principle is that the function produces side effects that do not exist when it is not used: Access instances remain open. A question that arises is whether or not these instances are empty. It seems to me that closing the last instance will totally close this leftover, but I am still uncertain when this may depend on the answer to the previous question.
The test procedure I have used is two-stage. A first procedure located in an Access database opens with the Shell command about ten other Access databases and a second one closes them (Getobject(aFile).Quit) . Thus an Access database remains always open.
The test consists in using or not using the incriminated function between the two procedures and to note what differs in the application manager, and also in the result of the function itself. This test is considered successful if there is no other instance left than the current one having used this function between the openings and closings. I remind you that this function is supposed to be purely readable and therefore without any consequence on the system.
1°) The test described above is generally positive: the instances are cleaned after they are closed. Nevertheless, I still saw one or two of them dragging.
2°) When you close the bases manually instead of using the closing procedure, the instances remain. Alexandru, could you try this test and tell me if you observe the same thing?
This is the demonstration, whose reproducibility I don't know yet, that the function does produce a system malfunction. In real work I had noticed that sometimes some instances still had their base (CurrentDb) open under the conditions I have described: locked in their invisibility. In fact, other visible effects in the task manager occur more or less randomly. For example to have an open and functional Access instance that does not appear in the task manager.
My approach to build this function has been very empirical. In particular, I learned from a code that allows the same thing with Excel. Since Excel is now mono-instance, I could not test this function, but I assume nevertheless that it is well written and that it works without side effects.
Here is the excerpt of the code we are interested in:
Function GetXLapp(hWinXL As Long, xlApp As Object) As Boolean
Dim hWinDesk As Long, hWin7 As Long
Dim obj As Object
Dim iid As GUID
Call IIDFromString(StrPtr(IID_IDispatch), iid)
hWinDesk = FindWindowEx(hWinXL, 0&, "XLDESK", vbNullString)
hWin7 = FindWindowEx(hWinDesk, 0&, "EXCEL7", vbNullString)
If AccessibleObjectFromWindow(hWin7, OBJID_NATIVEOM, iid, obj) = S_OK Then
Set xlApp = obj.Application
GetXLapp = True
End If
End Function
One can see that there are two successive window calls, this is the aspect I shunted in an experiment that was not supposed to work, but it still gave the result I have here. Functional, but producing instability. That's it, my question is whole, should we make this intermediate call with Access and if so how? Is it something else?, etc.
Try this
Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hWnd As LongPtr, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long
Private Declare PtrSafe Function FindWindowExA Lib "User32" (ByVal hwndParent As LongPtr, ByVal hwndChildAfter As LongPtr, ByVal lpszClass As String, ByVal lpszWindow As String) As LongPtr
Public Function getAccessInstanceList() As Collection
Dim GUID&(0 To 3), acc As Object, hWnd
GUID(0) = &H20400
GUID(1) = &H0
GUID(2) = &HC0
GUID(3) = &H46000000
Set getAccessInstanceList = New Collection
Do
hWnd = FindWindowExA(0, hWnd, "OMain", vbNullString)
If hWnd = 0 Then Exit Do
If AccessibleObjectFromWindow(hWnd, &HFFFFFFF0, GUID(0), acc) = 0 Then
getAccessInstanceList.add acc.Application
End If
Loop
End Function
I am developing an application which opens and reads an XML document previously embedded in a PowerPoint presentation, or a Word document. In order to read this object (xmlFile as Object) I have to do:
xmlFile.OLEFormat.DoVerb 1
This opens the package object, and I have another subroutine that gets the open instance of Notepad.exe, and reads its contents in to ADODB stream.
An example of this procedure is available on Google Docs:
XML_Test.pptm.
During this process there is a few seconds window where the Notepad.exe gains focus, and an inadvertent keystroke may cause undesired results or error reading the XML data.
I am looking for one of two things:
Either a method to prevent the user from inadvertently inputting (via keyboard/mouse/etc) while this operation is being performed. Preferably something that does not take control of the user's machine like MouseKeyboardTest subroutine, below. Or,
A better method of extracting the XML data into a string variable.
For #1: this is the function that I found, which I am leery of using. I am wary of taking this sort of control of the users system. ##Are there any other methods that I might use?##
Private Declare Function BlockInput Lib "USER32.dll" (ByVal fBlockIt As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub MouseKeyboardTest() 'both keyboard and mouse blocked
BlockInput True ' Turns off Keyboard and Mouse
' Routine goes here
Sleep 5000 ' Optional coding
BlockInput False ' Turns on Keyboard and Mouse
End Sub
For #2: Some background, but the issue seems to be the inability to extract the embedded object reliably using any method other than DoVerb 1. Since I am dealing with an unsaved document in an application (Notepad) that is immune to my VBA skillz, this seems to be the only way to do this. Full background on that, here:
Extracting an OLEObject (XML Document) from PowerPoint VBA
As you correctly guessed in the comment above that taking the focus away from notepad will solve your problem. The below code does exactly that.
LOGIC:
A. Loop through the shape and get it's name. In your scenario it would be something like Chart Meta XML_fbc9775a-19ea-.txt
B. Use APIs like FindWindow, GetWindowTextLength, GetWindow etc to get the handle of the notepad window using partial caption.
C. Use the ShowWindow API to minimize the window
Code (tested in VBA-Powerpoint)
Paste this code in a module in the above PPTM
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowText Lib "User32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "User32" Alias _
"GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function GetWindow Lib "User32" (ByVal hWnd As Long, _
ByVal wCmd As Long) As Long
Private Declare Function ShowWindow Lib "User32" (ByVal hWnd As Long, _
ByVal nCmdShow As Long) As Long
Private Const GW_HWNDNEXT = 2
Private Const SW_SHOWMINIMIZED = 2
Sub Sample()
Dim shp As Shape
Dim winName As String
Dim Ret As Long
For Each shp In ActivePresentation.Slides(1).Shapes
If shp.Type = msoEmbeddedOLEObject Then
winName = shp.Name
shp.OLEFormat.Activate
Exit For
End If
Next
If winName <> "" Then
Wait 1
If GetHwndFromCaption(Ret, Replace(winName, ".txt", "")) = True Then
Call ShowWindow(Ret, SW_SHOWMINIMIZED)
Else
MsgBox "Window not found!", vbOKOnly + vbExclamation
End If
End If
End Sub
Private Function GetHwndFromCaption(ByRef lWnd As Long, ByVal sCaption As String) As Boolean
Dim Ret As Long
Dim sStr As String
GetHwndFromCaption = False
Ret = FindWindow(vbNullString, vbNullString)
Do While Ret <> 0
sStr = String(GetWindowTextLength(Ret) + 1, Chr$(0))
GetWindowText Ret, sStr, Len(sStr)
sStr = Left$(sStr, Len(sStr) - 1)
If InStr(1, sStr, sCaption) > 0 Then
GetHwndFromCaption = True
lWnd = Ret
Exit Do
End If
Ret = GetWindow(Ret, GW_HWNDNEXT)
Loop
End Function
Private Sub Wait(ByVal nSec As Long)
nSec = nSec + Timer
While nSec > Timer
DoEvents
Wend
End Sub
My understanding is that you have control over how XML file gets embedded into PowerPoint presentation in the first place. Here I do not quite understand why you chose to keep the data you need as contents of an embedded object.
To be sure, the task of getting those contents back is not a piece of cake. Actually, as long as there is no (simple or even moderately difficult) way to call QueryInterface and use IPersist* interfaces from VBA, there is just one way to get to contents of embedded object. The way involves following steps:
Activate an embedded object. You used OLEFormat.DoVerb 1 for that. A better way would be to call OLEFormat.Activate, but this is irrelevant for your particular problem.
Use embedded object's programming model to perform useful operations like getting contents, saving or whatever is exposed. Notepad.exe exposes no such programming model, and you resorted to WinAPI which is the best choice available.
Unfortunately, your current approach has at least 2 flaws:
The one you identified in the question (activation of notepad.exe leading to possibility of user's interference).
If a user has default program for opening .txt files other than notepad.exe, your approach is doomed.
If you do have control over how embedded object is created then better approach would be to store your XML data in some property of Shape object. I would use Shape.AlternativeText (very straightforward to use; shouldn't be used if you export your .pptm to HTML or have some different scenario where AlternativeText matters) or Shape.Tags (this one is probably the most semantically correct for the task) for that.
I don't think that blocking the user is the right approach,
If you must use a content of a notepad window, I would suggest using the SendKeys method, in order to send this combination:
SendKeys("^A^C")
Which is the equivalent of "Select All" and "Copy",
And then you could continue working "offline" on the clipboard, without fear of interference by keystrokes.
My approach, per Sid's suggestion, was to find a way to minimize the Notepad.exe. Since I already found way to get that object and close it, I figured this should not be as hard.
I add these:
Public Declare Function _
ShowWindow& Lib "user32" (ByVal hwnd As Long, _
ByVal ncmdshow As Long)
Public Const SW_MINIMIZE = 6
And then, in the FindNotepad function, right before Exit Function (so, after the Notepad has been found) I minimize the window with:
ShowWindow TopWnd, SW_MINIMIZE
Running VBA under XP I was able to call ActivateKeyboardLayout to switch my input language from English to another language. However, this no longer works under Vista64.
Any suggestions or workarounds?
The code that used to work under XP was similar to the following:
Private Declare Function ActivateKeyboardLayout Lib "user32" ( _
ByVal HKL As Long, ByVal flags As Integer) As Integer
Const aklPUNJABI As Long = &H4460446
ActivateKeyboardLayout aklPUNJABI, 0
There was a suggestion to try
Public Declare Function ActivateKeyboardLayout Lib "user32" ( _
ByVal nkl As IntPtr, ByVal Flags As uint) As Integer
When I try this I get the error message:
Variable uses an Automation type not supported in Visual Basic
Your declaration for the ActivateKeyboardLayout is actually incorrect. For 32-bit systems your code should be something like this:
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
The 64-bitness of the operating system is a bit of a red herring in this case. Since you are running a VBA app it must be running as a 32-bit app regardless of OS. I suspect your problem may be that on your Vista system the Punjabi keyboard layout that you want is not loaded. ActivateKeyboardLayout will only work to activate a keyboard layout that is already loaded. For some reason the designers of this API felt that failure due to the keyboard layout not existing was not an error so the LastDllError is not set. You may want to look into using LoadKeyboardLayout for this type of situation.
EDIT: To double check that the keyboard layout you are trying to get is actually loaded you can use this:
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
This is just a blind guess, but have you tried running your app as elevated administrator to see if it makes a difference? What's the error code / value of GetLastError?
Did you try a .Net line (as in VB.Net script or those snippets) like:
InputLanguage.CurrentInputLanguage =
InputLanguage.FromCulture(New System.Globalization.CultureInfo("ar-EG"))
InputLanguage should be supported for Vista64 with a .Net3.5
VB.Net code:
Public Sub ChangeInputLanguage(ByVal InputLang As InputLanguage)
If InputLanguage.InstalledInputLanguages.IndexOf(InputLang) = -1 Then
Throw New ArgumentOutOfRangeException()
End If
InputLanguage.CurrentInputLanguage = InputLang
End Sub
For 64-bit portability you may need to use IntPtr. Can you give this a shot?
Public Declare Function ActivateKeyboardLayout Lib "user32" (ByVal nkl As IntPtr, ByVal Flags As uint) As Integer
In 64-bit editions of Office apps, VBA is indeed 64-bit. See Office 2010 documentation for details of the changes. For the example given in Stephen Martin's answer, you will need to change the code as follows to add the PtrSafe attribute and fixup the parameters that have a HKL type in the Win32 API:
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
and
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
The thing that everyone seems to overlook here is that you are working in VBA, not in .NET. IntPtr is a .NET type which represents an integer which is native to the platform. On a 32-bit platform it is 32 bits, on a 64 bit platform, it is 64 bits.
Given that an HKL is a typedef for a handle, which is a typedef for PVOID which is a typedef for VOID *, it's exactly what you need, if you were using .NET.
VBA doesn't have anything for 64-bit numbers, so you have to take a different approach.
On a 64-bit machine, you will have to do something like this:
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
This should allow you to pass a 64 bit value on the stack to the API function (across two variables). However, if you are going to use this code on 64 bit and 32 bit machines, you are going to have to make two declarations of the API and then determine which one to call.
Also, any other code in VBA that calls APIs that deal with pointers or handles will have to be changed appropriately to handle 64 bit input (not 32).
On a side note, the original declaration of ActivateKeyboardLayout is wrong, as it had a return type of Integer, which is a 16-bit value, while the API returns a type of HKL, which is 32 or 64 bits, depending on the platform.