I am using the following code to change word icon in windows taskbar from the usual word icon to an icon I have made.
But it doesn't work...only changes the small icon on the top-left corner of the application or userform.(not the taskbar)
I tried solution on the web including this link(
how to change the Excel Icon in Taskbar while loading,
Cannot change excel icon (in taskbar) with vba) and searched on stackoverflow.com but it couldn't help.
I am using Windows 10 & word 2010(I also tried this code on excel but it was same.)
I hope someone can help....
#If VBA7 And Win64 Then
Private Declare PtrSafe Function ExtractIconA Lib "shell32.dll" _
(ByVal hInst As LongPtr, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As LongPtr
Private Declare PtrSafe Function SendMessageA Lib "user32" _
(ByVal hwnd As LongPtr, _
ByVal wMsg As Long, _
ByVal wParam As LongPtr, _
ByVal lParam As LongPtr) As LongPtr
Declare PtrSafe Function GetActiveWindow32 Lib "user32" Alias "GetActiveWindow" () As Long
Private Const ICON_SMALL As LongPtr = 0&
Private Const ICON_BIG As LongPtr = 1&
Dim hwndIcon As LongPtr
#Else
Declare Function GetActiveWindow32 Lib "user32" Alias "GetActiveWindow" () As Integer
Declare Function SendMessage32 Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function ExtractIcon32 Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Const ICON_SMALL As Long = 0&
Private Const ICON_BIG As Long = 1&
Dim hwndIcon As Long
#End If
Private Const WM_SETICON As Long = &H80
Public Sub ChangeApplicationIcon()
bigIcon_Path = ThisDocument.path & "\DataDontTouch\Icon\32X32B32.ico"
smallIcon_Path = ThisDocument.path & "\DataDontTouch\Icon\16X16B32.ico"
bigIcon = ExtractIconA(0, bigIcon_Path, 0)
smallIcon = ExtractIconA(0, smallIcon_Path, 0)
SendMessageA GetActiveWindow32(), &H80, 0&, smallIcon
SendMessageA GetActiveWindow32(), &H80, 1&, bigIcon
ActiveWindow.Caption = "Fast.exe"
End Sub
Related
I am struggling to get listbox items from a 3rd party application. cant find away to get the list items from the listbox, have search for a week and have not find any solution.
Is there anyone that have a clue what to do.
Update!!
I struggle to get the verbose information form the listbox, shown in picture 3, red marking. When i use LB_GETTEXT i only get the first row. Is there a way to get all lines from the multi-line listbox item?
Some one up for this challenge :)
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal
lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal
hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String)
As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal
hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Sub windows_API_Test()
Const LB_GETCOUNT = &H18B
Const LB_GETTOPINDEX = &H18E
Const LB_GETTEXTLEN = &H18A
Const LB_GETTEXT = &H189
Do
DoEvents
Main_window = FindWindow(vbNullString, "Select passes to be exported")
Listbox_window = FindWindowEx(Main_window, 0&, "Listbox", vbNullString)
Loop Until Listbox_window > 0
numberofindex = SendMessage(Listbox_window, LB_GETCOUNT, 0, ByVal 0&)
TopIndex = SendMessage(Listbox_window, LB_GETTOPINDEX, 0, 0)
For i = TopIndex To numberofindex - 1
textcount = SendMessage(Listbox_window, LB_GETTEXTLEN, i, 0)
'space for null terminating string '\0' will be automatically added by VB
buffer$ = Space$(textcount)
' pass string byval not byref
' also make sure that lParam of SendMessage is declared as ANY
Call SendMessage(Listbox_window, LB_GETTEXT, i, ByVal buffer$)
Debug.Print buffer$
Next i
End Sub
Info from Spy++
Listbox from 3rd party application
How to get information circled in red?
I have a userform (userform1) with several controls. One control is a command button which will open a second userform (userform2).
I want that userform2 opens immediately bellow the button and centered with it.
To have the same behavior regardless the system/themes definitions for Windows, I need to know the sizes of the borders of userform1.
After digging during 3 days, I used API functions GetWindowRect and GetWindowClient. With these two API routines, I can find the TOTAL sizes of the horizontal borders (upper plus lower) and of the vertical borders (left plus right), but not them individually.
For vertical borders, it is common sense that they will have the same thickness (width) — in fact, I’ve never seen a window with different left and right borders. So, the solution is to divide by 2 the total size. However, for horizontal borders this cannot be used, since the upper border is usually thicker that the lower.
Eventually, I found a workaround for the problem, but it cannot be applied always. That is, if there is a frame control inside userform1, then the API function GetWindowRect can be used to find the “absolute” coordinates of the frame, i.e., referred to the screen, not to userform1. Then, the upper border size is given by: frame.top_Absolute – (Userform1.top_Absolute - frame.top_RelativeToUserform1).
The problem of this approach is, userforms have not frame controls always. On the other hand, not all controls have a “rectangle” property; therefore, GetWindowRect cannot be used for all controls.
Question: is there a “direct” way to find the size of the borders of a userform?
Code
In an ordinary module:
Option Explicit
'API Declarations
#If VBA7 Then
Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal Index As Long) As Long
Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnD As Long) As Long
Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnD As Long, ByVal hDC As Long) As Long
Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal Index As Long) As Long
Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnD As Long, ByRef lpRect As udtRECT) As Long
Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hWnD As Long, ByRef lpRect As udtRECT) As Long
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#Else
Declare Function GetSystemMetrics Lib "user32" (ByVal Index As Long) As Long
Declare Function GetDC Lib "user32" (ByVal hWnD As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hWnD As Long, ByVal hDC As Long) As Long
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal Index As Long) As Long
Declare Function GetWindowRect Lib "user32" (ByVal hWnD As Long, ByRef lpRect As udtRECT) As Long
Declare Function GetClientRect Lib "user32" (ByVal hWnD As Long, ByRef lpRect As udtRECT) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If
Type udtRECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Type BorderSize
TopHeight As Long
LeftWidth As Long
BottomHeight As Long
RightWidth As Long
End Type
Public FormBorders As BorderSize
'To determine the sizes of the borders
Public Sub GetFormBorders(ByVal FormHandler As Long, ByVal FrameHandler As Long)
Dim rectForm As udtRECT
Dim rectFrame As udtRECT
Dim rectClientForm As udtRECT
Dim Trash As Long
Trash = GetWindowRect(FormHandler, rectForm)
Trash = GetWindowRect(FrameHandler, rectFrame)
Trash = GetClientRect(FormHandler, rectClientForm)
FormBorders.TopHeight = ConvertPixelsToPoints(rectFrame.Top - rectForm.Top, "Y") - frmFlyschGSI.fraRockProp.Top 'userform1.frame.top
FormBorders.LeftWidth = ConvertPixelsToPoints(rectFrame.Left - rectForm.Left, "X") - frmFlyschGSI.fraRockProp.Left
FormBorders.BottomHeight = ConvertPixelsToPoints(rectForm.Bottom - rectForm.Top, "Y") - FormBorders.TopHeight - _
ConvertPixelsToPoints(rectClientForm.Bottom - rectClientForm.Top, "Y")
FormBorders.RightWidth = ConvertPixelsToPoints(rectForm.Right - rectForm.Left, "X") - FormBorders.LeftWidth - _
ConvertPixelsToPoints(rectClientForm.Right - rectClientForm.Left, "X")
Debug.Print FormBorders.TopHeight, FormBorders.LeftWidth, FormBorders.BottomHeight, FormBorders.RightWidth
End Sub
'To convert pixels to points
Public Function ConvertPixelsToPoints(ByVal sngPixels As Single, ByVal sXorY As String) As Single
'Credits to: https://bettersolutions.com/vba/userforms/positioning.htm
Dim hDC As Long
hDC = GetDC(0)
If sXorY = "X" Then
ConvertPixelsToPoints = sngPixels * (72 / GetDeviceCaps(hDC, 88))
End If
If sXorY = "Y" Then
ConvertPixelsToPoints = sngPixels * (72 / GetDeviceCaps(hDC, 90))
End If
Call ReleaseDC(0, hDC)
End Function
'In the Userform code sheet:
Option Explicit
Private Sub UserForm_Initialize()
'Some code here
If Me.Visible = False Then
Call GetFormBorders(FindWindow(vbNullString, frmFlyschGSI.Caption), frmFlyschGSI.fraRockProp.[_GethWnd])
End If
'More code here
End Sub
Private Sub cmdMiHarder_Click()
Dim FrameBorder As udtRECT
Dim Trash As Long
Dim sngTopBorder As Single
Dim sngLeftBorder As Single
'Some code here
Trash = GetWindowRect(Me.fraRockProp.[_GethWnd], FrameBorder)
sngTopBorder = ConvertPixelsToPoints(FrameBorder.Top, "Y") - (Me.Top + Me.fraRockProp.Top)
sngLeftBorder = ConvertPixelsToPoints(FrameBorder.Left, "X") - (Me.Left + Me.fraRockProp.Left)
'More code here
End Sub
Logic:
Show Userform1 as modeless. This is required so that Userform2 can be shown as modeless
Show Userform2 as modeless. This is required so that Userform2 can be moved
Move Userform2 to the relevant position
New Position Calculations:
Can be much better explained with the below image
In a Module:
Option Explicit
Sub Sample()
UserForm1.Show vbModeless
End Sub
In Userform1 code area:
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ClientToScreen Lib "user32" _
(ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetDeviceCaps Lib "Gdi32" _
(ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" _
(ByVal hwnd As Long, ByVal hDC 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
Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Private Type POINTAPI
x As Long
y As Long
End Type
Private Const HWND_TOP = 0
Private Const SWP_NOSIZE = &H1
Private Sub CommandButton1_Click()
RepositionForm UserForm2, CommandButton1
End Sub
Public Sub RepositionForm(f As Object, c As Object)
Dim P As POINTAPI
Dim meHwnd As Long, hwnd As Long
meHwnd = FindWindow(vbNullString, Me.Caption)
P.x = (c.Left - (f.Width / 4)) / PointsPerPixelX
P.y = (c.Top + c.Height) / PointsPerPixelY
'~~> The ClientToScreen function converts the client coordinates
'~~> of a specified point to screen coordinates.
ClientToScreen meHwnd, P
UserForm2.Show vbModeless
'~~> Get Handle of Userform2
hwnd = FindWindow("ThunderDFrame", "UserForm2")
'~~> Move the form to relevant location
SetWindowPos hwnd, HWND_TOP, P.x, P.y, 0, 0, SWP_NOSIZE
End Sub
Private Function PointsPerPixelX() As Double
Dim hDC As Long
hDC = GetDC(0)
PointsPerPixelX = 72 / GetDeviceCaps(hDC, LOGPIXELSX)
ReleaseDC 0, hDC
End Function
Public Function PointsPerPixelY() As Double
Dim hDC As Long
hDC = GetDC(0)
PointsPerPixelY = 72 / GetDeviceCaps(hDC, LOGPIXELSY)
ReleaseDC 0, hDC
End Function
Screenshot
I can answer to my own question now after reading Siddharth Rout’s code. The key is to use the ClientToScreen API function to find the “screen” coordinates of the upper left corner of the client window (of the userform).
I am leaving here the code, in case someone needs to know the border sizes of a userform.
In a ordinary module:
Option Explicit
'
'API Declarations
'
#If VBA7 Then
Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnD As Long) As Long
Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnD As Long, ByVal hDC As Long) As Long
Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal Index As Long) As Long
Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnD As Long, ByRef lpRect As udtRECT) As Long
Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hWnD As Long, ByRef lpRect As udtRECT) As Long
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare PtrSafe Function ClientToScreen Lib "user32" (ByVal hWnD As Long, ByRef lpPoint As PointAPI) As Long
#Else
Declare Function GetDC Lib "user32" (ByVal hWnD As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hWnD As Long, ByVal hDC As Long) As Long
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal Index As Long) As Long
Declare Function GetWindowRect Lib "user32" (ByVal hWnD As Long, ByRef lpRect As udtRECT) As Long
Declare Function GetClientRect Lib "user32" (ByVal hWnD As Long, ByRef lpRect As udtRECT) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function ClientToScreen Lib "user32" (ByVal hWnD As Long, ByRef lpPoint As PointAPI) As Long
#End If
'
Public Type udtRECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'
Public Type PointAPI
x As Long
y As Long
End Type
'
Public Type BorderSize
TopHeight As Single
LeftWidth As Single
BottomHeight As Single
RightWidth As Single
End Type
'
' To determine the sizes of the borders
'
Public Function FormBorders(ByVal FormHandler As Long) As BorderSize
'
' Credits to Siddharth Rout for the usage of ClientToScreen API function in this context.
'
Dim rectWindow As udtRECT
Dim rectClient As udtRECT
Dim P As PointAPI
Dim VerBorders As Single
Dim HorBorders As Single
Dim Trash As Long
'
Trash = GetWindowRect(FormHandler, rectWindow)
Trash = GetClientRect(FormHandler, rectClient)
'
' Sets the upper left corner of the "client" window...
P.x = 0
P.y = 0
Trash = ClientToScreen(FormHandler, P) '...and gets its screen coordinates.
'
' Total dimensions of the borders in points, after converting pixels to points:
VerBorders = ConvertPixelsToPoints((rectWindow.Right - rectWindow.Left) - (rectClient.Right - rectClient.Left), "X")
HorBorders = ConvertPixelsToPoints((rectWindow.Bottom - rectWindow.Top) - (rectClient.Bottom - rectClient.Top), "Y")
'
' Now the individual borders, one by one, in points:
FormBorders.TopHeight = ConvertPixelsToPoints(P.y - rectWindow.Top, "Y")
FormBorders.BottomHeight = HorBorders - FormBorders.TopHeight
FormBorders.LeftWidth = ConvertPixelsToPoints(P.x - rectWindow.Left, "X")
FormBorders.RightWidth = VerBorders - FormBorders.LeftWidth
'
Debug.Print FormBorders.TopHeight, FormBorders.LeftWidth, FormBorders.BottomHeight, FormBorders.RightWidth
'
End Function
'
'To convert pixels to points
'
Public Function ConvertPixelsToPoints(ByVal sngPixels As Single, ByVal sXorY As String) As Single
'
'Credits to: https://bettersolutions.com/vba/userforms/positioning.htm
'
Dim hDC As Long
'
hDC = GetDC(0)
If sXorY = "X" Then
ConvertPixelsToPoints = sngPixels * (72 / GetDeviceCaps(hDC, 88))
End If
'
If sXorY = "Y" Then
ConvertPixelsToPoints = sngPixels * (72 / GetDeviceCaps(hDC, 90))
End If
Call ReleaseDC(0, hDC)
'
End Function
In the code sheet of the userform:
Option Explicit
Private Sub UserForm_Initialize()
'
Dim MeBorders As BorderSize
MeBorders = FormBorders(FindWindow(vbNullString, Me.Caption))
Debug.Print MeBorders.TopHeight, MeBorders.LeftWidth, MeBorders.BottomHeight, MeBorders.RightWidth
End Sub
I have searched a lot for a way to minimize the window of the driver in selenium for excel vba. I have found ways for Java and python and tried to adopt them but all my tries failed
I just found a way to maximize the window using
bot.Window.Maximize
But when trying to use Minimize I got an error
Again I am searching for excel vba as for selenium ...
Thanks advanced for help
AFAIK there is no method for this in VBA implementation (there is in Python for example). There are a number of ways to manipulate size and position e.g.
bot.Window.SetSize 0, 0
Or you can run headless
bot.AddArgument "--headless"
You might also try to:
1) Emulate Windows Key + Down
2) Write a javscript function that performs window.minimize() and async execute off the parent window
3) Capture your target co-ordinates by generating a GetWindowPlacement call along with implementing your own WINDOWPLACEMENT struct. Looks like gets ugly fast.
See also:
Getting the size of a minimized window
Driver.Window.SetSize 0, 0
just made the window smaller, without minimizing the browser to the taskbar.
How to use GetWindowPlacement in selenium vba?
'for vb6
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type WINDOWPLACEMENT
Length As Long
flags As Long
showCmd As Long
ptMinPosition As POINTAPI
ptMaxPosition As POINTAPI
rcNormalPosition As RECT
End Type
Private Declare Function GetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Private Sub Command1_Click()
Dim wp As WINDOWPLACEMENT
wp.Length = Len(wp)
GetWindowPlacement targetHandle, wp
End Sub
Minimize window by windows API
This is a workaround for Selenium VBA not having a working minimize window option.
''compiler constants
#If VBA7 Then
Public Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Boolean
Public Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
#Else
Public Declare Function ShowWindow Lib "USER32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Boolean
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public 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
#End If
Dim hwnd As Long
Dim Botwindowtitle As String
bot.Start
Botwindowtitle = bot.Window.Title
hwnd = GetAllWindowHandles(Botwindowtitle)
Call ShowWindow(hwnd, 7) 'Show the window minimized (SW_SHOWMINNOACTIVE = 7) http://www.jasinskionline.com/windowsapi/ref/s/showwindow.html
bot.Get "https://www.google.com/"
Private Function GetAllWindowHandles(partialName As String) As Long
Dim hwnd As Long, lngRet As Long
Dim strText As String
Dim hWndTemp As Long
hwnd = FindWindowEx(0&, 0&, vbNullString, vbNullString)
Do While hwnd <> 0
strText = String$(100, Chr$(0))
lngRet = GetWindowText(hwnd, strText, 100)
If InStr(1, strText, partialName, vbTextCompare) > 0 Then
Debug.Print "Window Handle:" & hwnd & vbNewLine & _
"Window title:" & Left$(strText, lngRet) & vbNewLine & _
"----------------------"
hWndTemp = hwnd
GetAllWindowHandles = hWndTemp
End If
'~~> Find next window
hwnd = FindWindowEx(0&, hwnd, vbNullString, vbNullString)
Loop
End Function
It's a bit of a silly question, but how do you close a folder through Excel VBA ? Below the code to opening it,
Shell "Explorer.exe \\sharepoint.com#SSL\DavWWWRoot\sites\folder", vbMinimizedFocus
This solution with the process ID unfortunately does not work.
The following code loops through all opened Explorer windows. So you can use that to match against the LocationURL and get the window handle hWnd and use Windows API SendMessage to close the window.
Option Explicit
'for 64-bit Excel use
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Long) As LongPtr
'for 32-bit Excel use
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Const WM_SYSCOMMAND = &H112
Const SC_CLOSE = &HF060
Public Sub CloseWindowExample()
Dim sh As Object
Set sh = CreateObject("shell.application")
Dim w As Variant
For Each w In sh.Windows
'print all locations in the intermediate window
Debug.Print w.LocationURL
' select correct shell window by LocationURL
If w.LocationURL = "file://sharepoint.com#SSL/DavWWWRoot/sites/folder" Then
SendMessage w.hWnd, WM_SYSCOMMAND, SC_CLOSE, 0
End If
Next w
End Sub
Note that the LocationURL path begins with file:// and that all backslashes \ in the path are converted to slashes / as shown in the example.
To make it compatible with both 64 and 32 bit Excel you can use
#If VBA7 Then
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Long) As LongPtr
#Else
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
#End If
Note that one of these will be marked in red as compile error but the code will still run.
I am trying to minimize a Userform when it is running a method in it. Functionality in my method is so huge that it is running for long time. I would like to minimize UserForm so that I could work on some other excel sheets and later come back to UserForm (or restore it) during this run.
When UserForm is running, it is not allowing to access any of its components(so that even if i add minimize button its of no use). I am able to access other excels and work on them because i have made Userform as vbmodeless, but my requirement is userform should be minimized, now I am dragging UserForm to the end of the screen to view other files easily.
Why not add a minimize / maximize to your userform ;)
Here is something from my database (Not my Code). Paste this in the userform
Option Explicit
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" _
(ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Const WS_MINIMIZEBOX As Long = &H20000
Private Const WS_MAXIMIZEBOX As Long = &H10000
Private Const GWL_STYLE As Long = (-16)
Private Const WS_SYSMENU As Long = &H80000
Private Const SW_SHOWMAXIMIZED = 3
Private Sub UserForm_Activate()
Dim Ret As Long, styl As Long
Ret = FindWindow("ThunderDFrame", Me.Caption)
styl = GetWindowLong(Ret, GWL_STYLE)
styl = styl Or WS_SYSMENU
styl = styl Or WS_MINIMIZEBOX
styl = styl Or WS_MAXIMIZEBOX
SetWindowLong Ret, GWL_STYLE, (styl)
DrawMenuBar Ret
End Sub
Screenshot