I have VBA code that runs every time a new email message is received. It has several processing steps including creating excel spreadsheets, so can take a minute or two to execute.
I would like to display a modeless dialog box that shows updated status messages as processing of the email progresses. I created a UserForm1, but can't figure out how to instantiate it from the VBA code.
Like so:
Dim uf As UserForm1
Set uf = New UserForm1
uf.Show False
However, this is not a good practice as a notification should be modal. Maybe you want SystemModal (in front of ALL windows) instead of ApplicationModal (in front of Application)? The VBA MsgBox can be quite customized actually so check out this post here to learn more on how to customize a MsgBox.
To make a Window TopMost
If you want your Form window to be TopMost try this:
https://support.microsoft.com/en-us/kb/184297
Option Explicit
Public Const SWP_NOMOVE = 2
Public Const SWP_NOSIZE = 1
Public Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" _
(ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long ) As Long
Public Function SetTopMostWindow(hwnd As Long, Topmost As Boolean) _
As Long
If Topmost = True Then 'Make the window topmost
SetTopMostWindow = SetWindowPos(hwnd, HWND_TOPMOST, 0, 0, 0, _
0, FLAGS)
Else
SetTopMostWindow = SetWindowPos(hwnd, HWND_NOTOPMOST, 0, 0, _
0, 0,FLAGS)
SetTopMostWindow = False
End If
End Function
To use this on your form:
res = SetTopMostWindow(uf.hwnd, True)
Final version of the test code after receiving info from #AnalystCave.com follows. Still working on how to force the userform to stay on top of the other windows.
Public Sub TestForm()
Dim uf As UserForm1
Set uf = New UserForm1
Load uf
uf.Show vbModeless
uf.msgStatus.Text = "11111111111111111"
uf.msgStatus.Text = "22222222222222222"
uf.msgStatus.Text = "33333333333333333"
uf.Hide
Unload uf
End Sub
In my particular application, what appears on the desktop is predictable. In this case, one way to solve the problem is:
''' execute something that you know will show on top of the userform then
uf.Show vbModeless ' this will put the userform back on top
Related
I'm running a PowerPoint Macro-Enabled Slide Show. When a user opens this file the presentation starts immediately. The presentation contains various shapes that, when pressed (use of links), will open a new Powerpoint Slide Show in front of the main Slide Show.
In the background I'm using VBA (code is located in the main Macro enabled slide show) to measure the time a user spends on all of the slides. I want the user to be able to stop this timer with a userform and a button. However, when a new Powerpoint Slide Show is opened, it appears in front of the main slide show. The userform will then disappears behind the new slide show. Using a second screen i have been able to view the userform. But when clicked on the userform it brings the main slide show in front of the other slide show.
So in short: I would like a userform that is in front of all slide show windows.
I tried using vbmodeless but this does not help. I've also tried out various bits of code:
http://www.vbaexpress.com/forum/showthread.php?58189-Make-userform-stay-on-top-of-all-windows-when-macro-is-fired
https://www.mrexcel.com/board/threads/userform-always-on-top.386643/
https://www.mrexcel.com/board/threads/keeping-userform-on-top-when-changing-active-workbook.1165439/
Unfortunately, none of these seem to be working. Some of these are for excel and I've not been able to rewrite these bits of code.
P.S. If this isn't possible, maybe I could hide the main slide show?
Simple version
Create a class module, MyClass, and put this code there:
Public WithEvents App As Application
Private Sub App_SlideShowBegin(ByVal Wn As SlideShowWindow)
UserForm1.Show False
End Sub
Create a module and put this code in it:
Dim MyThing As New MyClass
Sub InitializeApp()
Set MyThing.App = Application
End Sub
Run the InitializeApp method first. Now, when you start your presentation, your UserForm1 will show up. The False flag makes it non-modal, which is what I think you are looking for.
Slightly more advanced version
As above, but change the module to this:
Option Explicit
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const HWND_TOP = 0
Public Const HWND_BOTTOM = 1
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Declare Function SetWindowPos Lib "user32" _
(ByVal hWnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal uFlags As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Dim MyThing As New MyClass
Sub InitializeApp()
Set MyThing.App = Application
End Sub
And add this to your form code:
Option Explicit
Option Explicit
Private Sub UserForm_Initialize()
Dim formHWnd As Long
formHWnd = FindWindow("ThunderDFrame", Me.Caption)
SetWindowPos formHWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub
I have an excel vba application that runs a separate process. During the external process a progress indicator with abort button is initialized. It is crucial for the end users that the abort button is available. It is also usefull to see the external process running.
I would like to have the progress indicator/abort button placed on top of the external process. but I do NOT wont to force the userform on top of everything.
I have tried to use findwindow / setwindowpos, resulting in the following problems:
If I initialize HWND_TOPMOST before running the process, then the userform is always on top, regardless of what the user wants. I find this very annoying, especially if some sort of errors occur where the debuging window might be blocked by the inactive vba userform. However the workbook remains in the background which is desired.
If I use HWND_TOP (after the external process is up and running) then the entire workbook is activated (not just the userform), which then hides to progress of the external application. Not very benificial compared to activating the workbook.
Are there any suggestions on how to put the userform in front of the external applicaiton, while still allowing the user to deactivate it?
code snippets:
Option Explicit
' Code stolen with pride from various sources.
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetWindowPos Lib "user32" ( _
ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const HWND_TOP = 0
Public Const HWND_BOTTOM = 1
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public id As Integer
Public ProgressForm As fProgress
' Main routine, launch application and progress indicator.
Sub LoadForm()
Set ProgressForm = New fProgress
ProgressForm.Show
' Force userform to front, makes it on top but does not allow reorder of windows.
ForceToFront ProgressForm
' Run external process, notepad used for example.
id = Shell("notepad", vbNormalFocus)
End Sub
' Routine to bring userform to front after the external program is up and running.
Sub TestBringToFront()
BringToFront ProgressForm
End Sub
Sub BringToFront(fm As fProgress)
Dim hwnd As Long, ret As Variant
hwnd = FindWindow("ThunderDFrame", fm.Caption)
ret = SetWindowPos(hwnd, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
End Sub
Sub ForceToFront(fm As fProgress)
Dim hwnd As Long, ret As Variant
hwnd = FindWindow("ThunderDFrame", fm.Caption)
ret = SetWindowPos(hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
End Sub
Unfortunately this is the designated behaviour of windows and applications. However, I can suggest some workarounds:
Use TOPMOST option and make the userform clickable, e.g. capture the ProgressForm_Click and toggle between TOPMOST and NOTOPMOST state. ALternatively use can employ an "Always On Top" checkbox on ProgressForm like it is in the Task Manager.
Use TOP option and resize the workbook window behind to as small as possible, or even move aside (out of the screen), and restore size and position after the external app finished.
It may be worthy making a try with ProgressForm.Show(vbModeless) and TOP
Icons disappearing in PopUp menu after setting the main (first) PopUp menu item Visible property to False, but they come back when Visible property switched back to Enable, why?
Option Explicit
Private Const MF_BITMAP = &H4&
Private Const MF_BYPOSITION As Long = &H400& '&H404&
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long
Public Sub SetPopUpMenuIcons(objFRM As Form)
On Error Resume Next
Dim lgRet As Long
Dim lgMnu As Long
Dim lgSubMnu As Long
lgMnu = GetMenu(objFRM.hwnd)
lgSubMnu = GetSubMenu(lgMnu, 0)
With objFRM
lgRet = SetMenuItemBitmaps(lgSubMnu, 0, MF_BYPOSITION, .imgMnu(0).Picture, 0)
lgRet = SetMenuItemBitmaps(lgSubMnu, 1, MF_BYPOSITION, .imgMnu(1).Picture, 0)
lgRet = SetMenuItemBitmaps(lgSubMnu, 2, MF_BYPOSITION, .imgMnu(2).Picture, 0)
lgRet = SetMenuItemBitmaps(lgSubMnu, 3, MF_BYPOSITION, .imgMnu(3).Picture, 0)
lgRet = SetMenuItemBitmaps(lgSubMnu, 4, MF_BYPOSITION, .imgMnu(4).Picture, 0)
End With
Exit Sub
End Sub
I believe that the VB6 PopupMenu method actually creates a new popup menu (by calling CreatePopupMenu) and then uses the hidden menu items as templates for creating items via InsertMenu or AppendMenu, but without using the bitmap flag and handles which it doesn't know you added behind its back.
You might have to do all of the work yourself, calling CreatePopupMenu and then InsertMenuItem instead of InsertMenu/AppendMenu for each item (in order to have both a bitmap and text), and use subclassing to get the selection "event" if any, and so on.
In other words there may be no trivial way to do what you want. The VB6 menu plumbing seems to be based on old 16-bit Windows (Win 3.x) logic and API calls.
Too bad we never got a real VB7! Microsoft had accumulated a vast list of such feature enhancements before pulling the plug in favor of .Net.
There may be a 3rd party menu control that could make this easier.
I want to develop an app which won't allow the user to open or jump to another application while it is open. It should be in Visual Basic. For example, if my application is open (running) and the user tries to open any other windows application like "media player" then it shouldn't open. The app should not even allow "task manager" to run. The application should completely block the windows environment while it is running.
A very good question. :)
Is is possible to achieve it in VB?
The answer is Yes!
Is it Easy?
Definitely not!
However here are few tips on how to approach the problem.
1) Disable the Task Manager
Sub DisableTaskManager()
Shell "REG add HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System /v DisableTaskMgr /t REG_DWORD /d 1 /f", vbNormalFocus
End Sub
Sub EnableTaskManager()
Shell "REG add HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System /v DisableTaskMgr /t REG_DWORD /d 0 /f", vbNormalFocus
End Sub
2) Ensure your program is always on top
a) Hide the task bar
Option Explicit
'~~> http://allapi.mentalis.org/apilist/FindWindow.shtml
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName _
As String) As Long
'~~> http://allapi.mentalis.org/apilist/SetWindowPos.shtml
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
'~~> Show/Hide Taskbar
Sub Sample()
'~~> To show the taskbar
ShowTskBar True
'~~> To hide the taskbar
ShowTskBar False
End Sub
Sub ShowTskBar(ShouldI As Boolean)
Dim Sid As Long
Sid = FindWindow("Shell_traywnd", "")
If ShouldI = True Then
If Sid > 0 Then _
Sid = SetWindowPos(Sid, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)
Else
If Sid > 0 Then _
Sid = SetWindowPos(Sid, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
End If
End Sub
b) Show your application Always on top
'~~> http://www.allapi.net/apilist/SetWindowPos.shtml
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOACTIVATE = &H10
Const SWP_SHOWWINDOW = &H40
Private Sub Form_Activate()
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, _
SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
End Sub
b) Show your application in maximized mode
Maximize your form so that the desktop shows only your form as it shows in a Kiosk application. Depending on the need you can also disable the minimize button or the title bar. In such a case do remember to add a button so that user can click that to exit the form.
3) Disable the Start Menu
This code depends on the Windows version that you are using. Do a search on Google, you will find plenty of examples.
Similarly, you have to take care of few small small things but this post will give you a good start. If you are looking for a complete solution in one place then I doubt you will ever get it ;)
HTH
Take a look at the Desktop APIi to create your own "sandbox" but very careful as it's very easy to lock yourself out of the primary desktop.
Also see this question for a bit more information.
Is there a way to have a desktop vb application take control of an already open browser window? For example, have it mouse click certain coordinates in the window or check if the window contains certain elements.
I've looked at using Microsoft Internet Controls(shdocvw) and MSHTML(IHTMLDocument2) but I am struggling on how to access elements of the browser window (e.g. body.innnerHTML).
You can use AppActivate in VBScript which you may be able to use in VB.NET
set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "iexplore"
WScript.Sleep 100
WshShell.AppActivate "Windows Internet Explorer"
WshShell.SendKeys "~"
WScript.Sleep 500
WshShell.SendKeys "www.google.com"
~ is to TAB, and you can use sendkeys to emulate keystrokes.
Add References to Microsoft HTML Object Library and Microsoft Internet Controls
Option Explicit On
Public Class Form1
'Functions used to set cursor location and mouse clicks
Public Declare Auto Function SetCursorPos Lib "User32.dll" (ByVal X As Integer, ByVal Y As Integer) As Long
Public Declare Sub mouse_event Lib "user32" Alias "mouse_event" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Declare Auto Function ShowWindow Lib "user32" (ByVal _
hwnd As Long, ByVal nCmdShow As Long) As Long
'Constants used for cursor and mouse functions, and to maximize window
Public Const SW_MAXIMIZE = 3
Public Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down
Public Const MOUSEEVENTF_LEFTUP = &H4 ' left button up
Public Const MOUSEEVENTF_RIGHTDOWN = &H8 ' right button down
Public Const MOUSEEVENTF_RIGHTUP = &H10 ' right button up
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'retrieve all the open instances of IE
Dim shellWindows = New SHDocVw.ShellWindowsClass()
Dim htmlInput As mshtml.HTMLInputElement
'for each instance of IE
For Each ie As SHDocVw.InternetExplorer In shellWindows
'If the title of the IE window matches the designated title
If ie.Document.title = "Page Title" Then
'retrieve the control with the designated field id
htmlInput = ie.Document.getElementById("fieldID")
'if the control's inner html matches the designated text
If htmlInput.innerHTML = "innerHTML" Then
'show the IE window maximized and with focus
ShowWindow(ie.HWND, SW_MAXIMIZE)
'move the cursor to the designated x,y coordinates
SetCursorPos(xCoord, yCoord)
'left mouse click down and up
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
'send the designated keyboard command
My.Computer.Keyboard.SendKeys("keyboardCommand")
End If
End If
Next
End Sub
End Class