copy

Monday, 6 October 2014



Changing Excel Icon & Creating Workbook Shortcut With A Custom Icon


Introduction



A common question when developing custom Excel applications is: “How to change the default icon of the main Excel window?” Another common question is: “How to change the default icon of the custom application, so as to not look like an Excel workbook?” Both questions address the same need; to customize the user interface. If you have spent countless of hours in workbook designing and code development, you always want to add a personal touch on the user interface of your application.

In this post we will try to answer to both questions. For the first one, the answer is quite straightforward and involves two Windows API functions, the ExtractIcon and the SendMessage. The ExtractIcon function retrieves a handle to an icon from the specified executable file, DLL, or icon file. Here is used to retrieve an icon handle from a user-defined icon file (no .DLL or .EXE file). On the other hand, the SendMessage function is used to send a specific message to the main Excel window forcing it to change its icon.

For the second question, unfortunately, there is no straight answer; probably there is no answer at all! Neither with Windows APIs, nor with any other programming technique can you change the icon of a single workbook (without changing the icon of all workbooks). However, there is a workaround. If your workbook is on a specific location at your hard disc, you can create a shortcut at the computer’s desktop, which will have a custom icon. In this way you give to the application user the illusion of custom application icon. So, in the next section we will see how to achieve this programmatically via VBA – actually the Windows Script Host object does the “dirty work”.



VBA code



As the macros name imply the ChangeExelIcon changes the default Excel icon to a user-specified icon, while the RestoreExcelIcon does the opposite.

Option Explicit

'-------------------------------------------------------------------------------------
'This module contains two macros for changing the Excel Icon of the current workbook.
'The ChangeExelIcon macro changes the default Excel icon to an icon that is specified
'by the user, whereas the RestoreExcelIcon does the opposite.

'Written By:    Christos Samaras
'Date:          05/10/2014
'E-mail:        xristos.samaras@gmail.com
'Site:          http://www.myengineeringworld.net
'-------------------------------------------------------------------------------------

'Declaring the necessary API functions and constants.
#If VBA7 And Win64 Then
    
    'For 64 bit Excel.
    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

    Private Const ICON_SMALL    As LongPtr = 0&
    Private Const ICON_BIG      As LongPtr = 1&
    Dim hwndIcon                As LongPtr

#Else

    'For 32 bit Excel.
    Private Declare Function ExtractIconA Lib "shell32.dll" _
                            (ByVal hInst As Long, _
                            ByVal lpszExeFileName As String, _
                            ByVal nIconIndex As Long) As Long
                            
    Private Declare Function SendMessageA Lib "user32" _
                            (ByVal hwnd As Long, _
                            ByVal wMsg As Long, _
                            ByVal wParam As Long, _
                            ByVal lParam 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
    
Sub ChangeExelIcon()
 
    'Get the icon handle.
    'You can use the full path of the icon file, i.e.:
    'hwndIcon = ExtractIconA(0, "C:\Users\Christos\Desktop\My Icon.ico", 0)
    'Or the icon path relative to the current workbook, i.e.:
    hwndIcon = ExtractIconA(0, ThisWorkbook.Path & "\My Icon.ico", 0)
     
    'Check if the icon handle is valid.
    If hwndIcon <> 0 Then
    
        'Change the icon.
        'For a big icon (32 x 32 pixels), use this line:
        'SendMessageA Application.HWnd, WM_SETICON, ICON_BIG, hwndIcon
        'For a small one (16 x 16 pixels), use the next line (typical case):
        SendMessageA Application.hwnd, WM_SETICON, ICON_SMALL, hwndIcon
        
        'Inform the user.
        MsgBox "Excel icon was changed successfully!", vbInformation, "Done"
    
    End If
    
End Sub
 
Sub RestoreExcelIcon()

    'Get the icon handle of Excel application.
    hwndIcon = ExtractIconA(0, Application.Path & "\Excel.exe", 0)
    
    'Check if the icon handle is valid.
    If hwndIcon <> 0 Then
    
        'Restore the original Excel icon.
        SendMessageA Application.hwnd, WM_SETICON, ICON_SMALL, hwndIcon

        'Inform the user.
        MsgBox "Excel icon was restored successfully!", vbInformation, "Done"
    
    End If
    
End Sub

Similarly, the CreateWorkbookShortcut macro creates a workbook shortcut at the computer's Desktop, whereas the DeleteWorkbookShortcut deletes that shortcut.

Option Explicit

'-------------------------------------------------------------------------------------
'This module contains a macro - CreateWorkbookShortcut - for creating a shortcut of
'the current workbook at the computer's Desktop; the shortcut has a custom icon.
'The other macro - DeleteWorkbookShortcut - deletes that shortcut from the Desktop.

'Written By:    Christos Samaras
'Date:          05/10/2014
'E-mail:        xristos.samaras@gmail.com
'Site:          http://www.myengineeringworld.net
'-------------------------------------------------------------------------------------

Sub CreateWorkbookShortcut()

    'Declaring the necessary variables.
    Dim WSHShell    As Object
    Dim Shortcut    As Object
    
    On Error GoTo ErrorHandler:

    'Create the Windows Script Host object.
    Set WSHShell = CreateObject("WScript.Shell")
    
    'Create the shortcut object.
    Set Shortcut = WSHShell.CreateShortcut(MyDesktop & "\" & WbookNameNoExtension & ".lnk")
    
    'Adjust the shortcut.
    With Shortcut
        .TargetPath = ThisWorkbook.FullName
        .IconLocation = ThisWorkbook.Path & "\My Icon.ico"
        .Save
    End With
    
    'Inform the user about the shortcut creation.
    MsgBox "The """ & WbookNameNoExtension & """ file has now a shortcut at your Desktop." & vbNewLine & _
            "Note that the shortcut has a custom icon!", vbInformation, "Done"
            
ErrorHandler:
    'Check for errors.
    If Err.Number <> 0 Then
        MsgBox Err.Description & "!", vbCritical, "Error Number " & Err.Number
    End If
    
    'Release the objects.
    Set Shortcut = Nothing
    Set WSHShell = Nothing
    
End Sub

Sub DeleteWorkbookShortcut()
    
    'If the shortcut file exists, then delete it.
    If FileExists(MyDesktop & "\" & WbookNameNoExtension & ".lnk") = True Then
        Kill MyDesktop & "\" & WbookNameNoExtension & ".lnk"
        MsgBox "The shortcut has been successfully removed from your Desktop!", vbInformation, "Done"
    Else
        MsgBox "Shortcut couldn't be found at your Desktop!", vbCritical, "Failed"
    End If

End Sub

Function MyDesktop() As String

    'Returns the Desktop location.
    MyDesktop = Environ("USERPROFILE") & "\Desktop"

End Function

Function WbookNameNoExtension() As String
    
    'Returns the workbook name without its extension.
    WbookNameNoExtension = Left(ActiveWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1))

End Function

Function FileExists(strFilePath As String) As Boolean

    'Checks if a file exists.
    On Error Resume Next
    If Not Dir(strFilePath, vbDirectory) = vbNullString Then FileExists = True
    On Error GoTo 0
   
End Function

Note that on MyDesktop function we have used the Windows environment variables, an easy way to retrieve main Windows paths via VBA. Please check this post for a complete list of all the available environment variables.



Downloads



Download

The zip file contains an Excel workbook along with a guitar icon in order to test the above macros. The workbook can be opened with Excel 2007 or newer. Please enable macros before using it.

Did you like this post? If yes, then share it with your friends. Thank you!



Categories:


Mechanical Engineer (Ph.D. cand.), M.Sc. Cranfield University, Dipl.-Ing. Aristotle University, Thessaloniki - Greece.
Communication: e-mail, Facebook, Twitter, Google+ and Linkedin. More info