تغییر آیکون پنجره

هنگامی که در حال ساختن یک برنامه سفارشی در اکسل هستید، می توانید با جایگزین کردن نماد پیش فرض پنجره اصلی اکسل با نماد سفارشی خود، آن را شخصی سازی کنید. می توانید از یک فایل ico حاوی یک نماد یا یک فایل exe یا dll که ممکن است حاوی هر تعداد نماد باشد استفاده کنید. این کد از توابع Windows API ExtractIcon برای دریافت نماد از یک فایل و SendMessage برای ارسال پیامی به پنجره استفاده می کند که به آن دستور می دهد نماد خود را تغییر دهد.

تعریف رویه این است:

Sub SetIcon(FileName As String, Optional Index As Long = 0)

در اینجا FileName نام فایل حاوی نماد است و Index مکان مبتنی بر 0 نماد مورد نظر است. اگر از یک فایل آیکون استفاده می کنید، شاخص باید 0 باشد، زیرا یک فایل نماد نماد فقط می تواند یک نماد داشته باشد. اگر از فایل exe یا فایل dll استفاده می کنید، Index نشان می دهد که کدام نماد را از فایل بازیابی کنید. بسیاری از ویرایشگرهای آیکون مانند MicroAngelo Toolset (که من به شدت توصیه می کنم) به شما امکان می دهند

کد تابع SetIcon در زیر نشان داده شده است. دستورالعمل های کامپایل شرطی (#if، #else) به شما امکان می دهد از این کد در نسخه های 32 بیتی یا 64 بیتی اکسل استفاده کنید.

#If 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

#Else
'''''''''''''''''''''''''''''
' 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
#End If


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.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
#If VBA7 And Win64 Then
    ' 64 bit Excel
    Dim HWnd As LongPtr
    Dim HIcon As LongPtr
#Else
    ' 32 bit Excel
    Dim HWnd As Long
    Dim HIcon As Long
#End 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

می توانید این رویه را با کدهایی مانند زیر فراخوانی کنید:

SetIcon "C:\Test\Chip.ico", 0

برای بازنشانی آیکون به نماد پیش فرض اکسل، از کدی مانند استفاده کنید

Dim FName As String
    FName = Application.Path & "\excel.exe"
    SetIcon FileName:=FName, Index:=0