Modifier l'icône d'un formulaire ou de l'application

Le code qui suit est à copier dans un module standard de la base de donnée, il permet de spécifier une icône pour un formulaire ou pour l'application.

L'argument "MyIcon" correspond au chemin complet de l'icône que l'on souhaite définir.
L'argument "frm" correspond au nom du formulaire dont on souhaite modifier l'icône, si cet argument n'est pas renseigné, ce sera l'icône de l'application qui sera modifiée.

Option Compare Database
Option Explicit

Public Declare Function LoadImage Lib "user32" Alias _
    "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, _
    ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, _
    ByVal un2 As Long) As Long

Public Declare Function SendMessage Lib "user32" Alias _
    "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, lParam As Any) As Long

Public Const WM_GETICON = &H7F
Public Const WM_SETICON = &H80
Public Const ICON_SMALL = 0
Public Const ICON_BIG = 1 '// LoadImage() image types
Public Const IMAGE_BITMAP = 0
Public Const IMAGE_ICON = 1
Public Const IMAGE_CURSOR = 2
Public Const IMAGE_ENHMETAFILE = 3 '// LoadImage() flags
Public Const LR_DEFAULTCOLOR = &H0
Public Const LR_MONOCHROME = &H1
Public Const LR_COLOR = &H2
Public Const LR_COPYRETURNORG = &H4
Public Const LR_COPYDELETEORG = &H8
Public Const LR_LOADFROMFILE = &H10
Public Const LR_LOADTRANSPARENT = &H20
Public Const LR_DEFAULTSIZE = &H40
Public Const LR_LOADMAP3DCOLORS = &H1000
Public Const LR_CREATEDIBHeader = &H2000
Public Const LR_COPYFROMRESOURCE = &H4000
Public Const LR_SHARED = &H8000

Public Function SetFormIcon(MyIcon As String, Optional frm As String) As Boolean
'Place un icon dans le menu de l'application ou dans un formulaire

Dim hIcon As Long
Dim hwnd As Long
Dim IconPath As String

IconPath = CurrentDBDir() & MyIcon
If Len(Dir(IconPath)) = 0 Then
    SetFormIcon = False
    Exit Function
Else
    If frm = "" Then
        hwnd = Application.hWndAccessApp
    Else
        hwnd = Forms(frm).hwnd
    End If
    hIcon = LoadImage(0&, IconPath, IMAGE_ICON, 16, 16, LR_LOADFROMFILE)
    '// wParam = 0; Setting small icon. wParam = 1; setting large icon
    If hIcon <> 0 Then
        Call SendMessage(hwnd, WM_SETICON, 0, ByVal hIcon)
        SetFormIcon = True
    End If
End If

End Function

Auteur : Jessy SEMPERE