ganesh_6663
New Member
- Joined
- Jul 15, 2021
- Messages
- 33
- Office Version
- 2016
- Platform
- Windows
Below code working fine to Minimize userform to task bar , but don't to insert icon . Kindly help me .
getting error in "Sub AddIcon(myForm)"
getting error in "Sub AddIcon(myForm)"
VBA Code:
Option Explicit
'API functions
#If VBA7 Then
#If Win64 Then
Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long _
) As LongPtr
#Else
Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long _
) As LongPtr
#End If
#If Win64 Then
Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr _
) As LongPtr
#Else
Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr _
) As LongPtr
#End If
Private Declare PtrSafe Function SetWindowPos Lib "user32" _
(ByVal hWnd As LongPtr, _
ByVal hWndInsertAfter As LongPtr, _
ByVal X As Long, ByVal Y As Long, _
ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long _
) As LongPtr
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String _
) As LongPtr
Private Declare PtrSafe Function GetActiveWindow Lib "user32.dll" () As Long
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As LongPtr, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any _
) As LongPtr
Private Declare PtrSafe Function DrawMenuBar Lib "user32" _
(ByVal hWnd As LongPtr) As LongPtr
#Else
Private Declare Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long _
) As Long
Private Declare Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong 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 Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String _
) As Long
Private Declare Function GetActiveWindow Lib "user32.dll" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any _
) As Long
Private Declare Function DrawMenuBar Lib "user32" _
(ByVal hWnd As Long) As Long
#End If
'Constants
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const GWL_EXSTYLE = (-20)
Private Const HWND_TOP = 0
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Const WS_EX_APPWINDOW = &H40000
Private Const GWL_STYLE = (-16)
Private Const WS_MINIMIZEBOX = &H20000
Private Const SWP_FRAMECHANGED = &H20
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&
Sub AddIcon(myForm)
'Add an icon on the titlebar
#If VBA7 Then
Dim hWnd As LongPtr
Dim lngRet As LongPtr
#Else
Dim hWnd As Long
Dim lngRet As Long
#End If
Dim hIcon As Long
'hIcon = Sheet1.Image1.Picture.Handle
hWnd = FindWindow(vbNullString, myForm.Caption)
lngRet = SendMessage(hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon)
lngRet = SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal hIcon)
lngRet = DrawMenuBar(hWnd)
End Sub
Sub AddMinimizeButton()
'Add a Minimize button to Userform
#If VBA7 Then
Dim hWnd As LongPtr
#Else
Dim hWnd As Long
#End If
hWnd = GetActiveWindow
Call SetWindowLongPtr(hWnd, GWL_STYLE, _
GetWindowLongPtr(hWnd, GWL_STYLE) Or _
WS_MINIMIZEBOX)
Call SetWindowPos(hWnd, 0, 0, 0, 0, 0, _
SWP_FRAMECHANGED Or _
SWP_NOMOVE Or _
SWP_NOSIZE)
End Sub
Sub AppTasklist(myForm)
'Add this userform into the Task bar
#If VBA7 Then
Dim WStyle As LongPtr
Dim Result As LongPtr
Dim hWnd As LongPtr
#Else
Dim WStyle As Long
Dim Result As Long
Dim hWnd As Long
#End If
hWnd = FindWindow(vbNullString, myForm.Caption)
WStyle = GetWindowLongPtr(hWnd, GWL_EXSTYLE)
WStyle = WStyle Or WS_EX_APPWINDOW
Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
SWP_NOMOVE Or _
SWP_NOSIZE Or _
SWP_NOACTIVATE Or _
SWP_HIDEWINDOW)
Result = SetWindowLongPtr(hWnd, GWL_EXSTYLE, WStyle)
Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
SWP_NOMOVE Or _
SWP_NOSIZE Or _
SWP_NOACTIVATE Or _
SWP_SHOWWINDOW)
End Sub