Michael van den Berg
New Member
Hey Guys,
Yesterday I made a code to launch the Tabtip OSK on a tablet when a specific userform is opened. After closing it however the normal use of this keyboard bugs out.
I think its from closing it incorrectly. I tried multiple ways of closing the program:
- .Close
- .Kill
- .Dispose
- .Terminate
- = null
Only .Terminate is working but its bugged out. Are there other methods to close the window of Tabtip I can try?
Gr. Michael
Yesterday I made a code to launch the Tabtip OSK on a tablet when a specific userform is opened. After closing it however the normal use of this keyboard bugs out.
I think its from closing it incorrectly. I tried multiple ways of closing the program:
- .Close
- .Kill
- .Dispose
- .Terminate
- = null
Only .Terminate is working but its bugged out. Are there other methods to close the window of Tabtip I can try?
Gr. Michael
Code:
Option Explicit
#If VBA7 And Win64 Then
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#Else
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If
Sub percentmutatie()
'voor rij
Dim intRow As Long
'voor input
Dim intMutatie As Long
'Opent het Onscreen Keyboard (OSK)
'Doet dit niet op een desktop
On Error Resume Next
ShellExecute 0, vbNullString, "tabtip.exe", vbNullString, "C:\", 1
On Error GoTo 0
'Geef de verandering aan in de inputbox
intMutatie = Application.InputBox(Prompt:= _
"Geef de procentuele verandering aan als geheel getal", _
Title:="Procentuele input", Default:=10, Type:=1)
'Sluit de OSK
Dim strTerminateThis As String 'The variable to hold the process to terminate
Dim objWMIcimv2 As Object
Dim objProcess As Object
Dim objList As Object
Dim intError As Integer
'Taptip to terminate,
strTerminateThis = "tabtip.exe"
'Connect to CIMV2 Namespace
Set objWMIcimv2 = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\.\root\cimv2")
'Find the process to terminate
Set objList = objWMIcimv2.ExecQuery _
("select * from win32_process where name='" & strTerminateThis & "'")
'If 0 then process isn't running
If objList.Count = 0 Then
Set objWMIcimv2 = Nothing
Set objList = Nothing
Set objProcess = Nothing
Else
'OK to continue with terminating the process
'Terminates a process and all of its threads.
For Each objProcess In objList
intError = objProcess.Terminate
'Return value is 0 for success. Any other number is an error.
If intError <> 0 Then
MsgBox "ERROR: Unable to terminate.", vbCritical, "Aborting"
Exit Sub
End If
Next
'ALL instances of specified process (strTerminateThis) has been terminated
Set objWMIcimv2 = Nothing
Set objList = Nothing
Set objProcess = Nothing
End If
'Vult de data in
If intMutatie = 0 Then
Exit Sub
Else
intRow = ActiveCell.Row
Range("G" & intRow).Value = intMutatie / 100
Range("I" & intRow).Value = "%"
Range("G" & intRow).NumberFormat = "0%"
End If
End Sub