Change File Icon and/or Title Bar Icon

Hello Casedias,

I am guessing you are running Windows 7 32 bit platform. If it 64 bit then should have been errors in the API code. I will have to research this further to find an answer.

No, It is actually Windows 7 Home Premuim - 64bit on my laptop. Running Excel 2010.

Hello Casedias,

In that case I need to make the needed changes to the 32 bit API code so it will run on a 64 bit system.

I can't thank you enough. I may be asking this prematurely, but will the 64bit version run properly on a 32bit system? I am assuming not, but don't know enough about this yet.

Hello Casedias,

64 bit code will not run correctly on a 32 bit platform.

Oh boy, that just opened a whole new can of worms!

I will now have to run tests on my 32 bit systems at work to ensure the codes i have written to date will work across the board.

Do you think that the original code you provided me will work on a 32 bit system then?

I apologize for all the questions, still very new to this.

Hello Casedias,

Delete all the previous macro code and copy and paste this code into the module. Hopefully, this will work without problems. Because this is new and untested API code, be sure to back up your workbook and close any other applications before you run this.

' Written: September 17, 2011
' Author:  Leith Ross
' Summary: Change the Excel Icon on 64 bit Windows platforms

'Constants
 Const IMAGE_ICON As Long = &H1
 Const WM_SETICON As Long = &H80
 Const ICON_BIG As Long = &H1

'Constants for Load Image's fuLoad Parameter (Load Resource)
 Const LR_DEFAULTCOLOR As Long = &H0
 Const LR_MONOCHROME As Long = &H1
 Const LR_COLOR As Long = &H2
 Const LR_COPYRETURNORG As Long = &H4
 Const LR_COPYDELETEORG As Long = &H8
 Const LR_LOADFROMFILE As Long = &H10
 Const LR_LOADTRANSPARENT As Long = &H20
 Const LR_DEFAULTSIZE As Long = &H40
 Const LR_VGACOLOR As Long = &H80
 Const LR_LOADMAP3DCOLORS As Long = &H1000
 Const LR_CREATEDIBSECTION As Long = &H2000
 Const LR_COPYFROMRESOURCE As Long = &H4000
 Const LR_SHARED As Long = &H8000

'Returns an Icon from a File (.ico)
 Private Declare PtrSafe Function LoadImage _
   Lib "user32" Alias "LoadImageA" _
     (ByVal hInst As LongPtr, _
      ByVal lpsz As String, _
      ByVal un1 As Long, _
      ByVal n1 As Long, _
      ByVal n2 As Long, _
      ByVal un2 As Long) As LongPtr

'Direct System what to do with the Window
 Private Declare PtrSafe Function SendMessage _
   Lib "user32" Alias "SendMessageA" _
     (ByVal hwnd As LongPtr, _
      ByVal wMsg As Long, _
      ByVal wParam As LongPtr, _
      ByRef lParam As Any) As LongPtr

'Redraw the Icons on the Window's Title Bar
 Private Declare PtrSafe Function DrawMenuBar _
   Lib "user32" Alias "DrawMenuBar" _
     (ByVal hwnd As LongPtr) As Long


Public Function ChangeExcelIcon(ByVal Icon_File_Path As String)
  
  Dim hwnd As LongPtr
  Dim hIcon As LongPtr
  Dim LoadMask As Long
  
    hwnd = Application.hwnd
    LoadMask = LR_LOADFROMFILE Or LR_DEFAULTSIZE Or LR_SHARED
    hIcon = LoadImage(0&, Icon_File_Path, IMAGE_ICON, 32, 32, LoadMask)

    Call SendMessage(hwnd, WM_SETICON, ICON_BIG, ByVal hIcon)
    Call DrawMenuBar(hwnd)

End Function


Sub IconTest()

  ChangeExcelIcon "C:\Documents and Settings\Admin.ADMINS\My Documents\Properties 16.ico"
  
End Sub

I have pasted this into a new module and ran the sub, but nothing is happening.

The only time I received an error was when I tried to call the macro from my workbook module: Private Sub Workbook Activate ()

The destination is in the System32 folder should that matter?