How to insert image in this code ?

ganesh_6663

New Member
Joined
Jul 15, 2021
Messages
33
Office Version
  1. 2016
Platform
  1. 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)"


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
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
One more question How to insert icon in excel ?
like given below , try with insert object but not working .
Kindly suggest

image.JPG
 
Upvote 0
I see, in the example ActiveX Image Controls are used. To insert one:
Ribbon > Developer tab > Insert > ActiveX Controls > Image
Right click on Image Control > Properties > Picture > ... button to import an icon file from disk.
Note that only "real" icons are accepted, so images like .BMP and .JPG are displayed in the Image Control, but wouldn't on the Windows task bar.
 
Upvote 0

Forum statistics

Threads
1,214,592
Messages
6,120,433
Members
448,961
Latest member
nzskater

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top