bradyboyy88
Well-known Member
- Joined
- Feb 25, 2015
- Messages
- 562
Hi,
I have the following code to update the icon in the taskbar for my userform below. It was great however, we have dual monitor setups and the primary monitor will show the correct icon in the task bar but all additional monitors have the usual excel icon. How can I switch all monitor taskbar icons for this?
I have the following code to update the icon in the taskbar for my userform below. It was great however, we have dual monitor setups and the primary monitor will show the correct icon in the task bar but all additional monitors have the usual excel icon. How can I switch all monitor taskbar icons for this?
Code:
Option Explicit
'--------------------------------Create Icons Variable Declarations (API Mainly)----------------------------------'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modSetIcon
' This module contains code to change the icon of the Excel main
' window. The code is compatible with 64-bit Office.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL] VBA7 And Win64 Then
'''''''''''''''''''''''''''''
' 64 bit Excel
'''''''''''''''''''''''''''''
Private Declare PtrSafe Function SendMessageA Lib "user32" _
(ByVal hWnd As LongPtr, _
ByVal wMsg As LongPtr, _
ByVal wParam As LongPtr, _
ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function ExtractIconA Lib "shell32.dll" _
(ByVal hInst As LongPtr, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As LongPtr) As Long
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&
Private Const WM_SETICON = &H80
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL]
'''''''''''''''''''''''''''''
' 32 bit Excel
'''''''''''''''''''''''''''''
Private Declare Function SendMessageA Lib "user32" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Integer, _
ByVal lParam As Long) As Long
Private Declare Function ExtractIconA Lib "shell32.dll" _
(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&
Private Const WM_SETICON As Long = &H80
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL] If
'-------------Lightbox userform windowframe removal Variable Declariations (API Mainly)----------------------------'
'All Windows API variables that must be declared via module and not class module
'Hide userform window frames. Used in class module HideTitleBar
Public Const GWL_STYLE = -16
Public Const WS_CAPTION = &HC00000
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare Function DrawMenuBar Lib "user32" ( _
ByVal hWnd As Long) As Long
Public Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
'------------------------------Open file API Calls--------------------------------------------'
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL] 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
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL]
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
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL] If
'--------------------------------Create Icons--------------------------------------------------'
Sub SetIcon(FileName As String, Optional index As Long = 0)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SetIcon
' This procedure sets the icon in the upper left corner of
' the main Excel window. FileName is the name of the file
' containing the icon. It may be an .ico file, an .exe file,
' or a .dll file. If it is an .ico file, Index must be 0
' or omitted. If it is an .exe or .dll file, Index is the
' 0-based index to the icon resource.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL] VBA7 And Win64 Then
' 64 bit Excel
Dim hWnd As LongPtr
Dim HIcon As LongPtr
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL]
' 32 bit Excel
Dim hWnd As Long
Dim HIcon As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL] If
Dim n As Long
Dim S As String
If Dir(FileName, vbNormal) = vbNullString Then
' file not found, get out
Exit Sub
End If
' get the extension of the file.
n = InStrRev(FileName, ".")
S = LCase(Mid(FileName, n + 1))
' ensure we have a valid file type
Select Case S
Case "exe", "ico", "dll"
' OK
Case Else
' invalid file type
Err.Raise 5
End Select
hWnd = Application.hWnd
If hWnd = 0 Then
Exit Sub
End If
HIcon = ExtractIconA(0, FileName, index)
If HIcon <> 0 Then
SendMessageA hWnd, WM_SETICON, ICON_SMALL, HIcon
End If
End Sub
Last edited:
