VBA Tipp: Formular mit eigenem Icon versehen

Aus DBWiki
Wechseln zu: Navigation, Suche

Aufgabenstellung

  • Ich möchte meinen Formularen eigene Icons zuweisen.
  • Das zugewiesene Icon ist in der Titelleiste des Formulars nur in der Normalansicht oder in der Popup-Ansicht sichtbar.
  • Als weitere Option kann das Icon auch zusätzlich in der Taskleiste angezeigt werden.

Lösung

Das geht mit den folgenden API-Funktionen und einer VBA-Prozedur, die in einem globalen Modul hinterlegt werden.

Private Declare Function LoadImageA Lib "user32" ( _
   ByVal hinst As Long, _
   ByVal lpszName As String, _
   ByVal uType As Long, _
   ByVal cxDesired As Long, _
   ByVal cyDesired As Long, _
   ByVal fuLoad As Long) As Long
 
Private Declare Function SendMessageA Lib "user32" ( _
   ByVal hWnd As Long, _
   ByVal Msg As Long, _
   ByVal wParam As Long, _
   ByRef lParam As Any) As Long
 
'Konstanten für LoadImage uType
Private Const IMAGE_BITMAP        As Long = 0
Private Const IMAGE_ICON          As Long = 1
Private Const IMAGE_CURSOR        As Long = 2
Private Const IMAGE_ENHMETAFILE   As Long = 3
 
'Konstante für LoadImage cxDesired
Private Const Iconbreite          As Long = 0 'Pixel
 
'Konstante für LoadImage cyDesired
Private Const Iconhöhe            As Long = 0 'Pixel
 
'Konstanten für LoadImage fuLoad
Private Const LR_DEFAULTCOLOR     As Long = &H0
Private Const LR_MONOCHROME       As Long = &H1
Private Const LR_COLOR            As Long = &H2
Private Const LR_COPYRETURNORG    As Long = &H4
Private Const LR_COPYDELETEORG    As Long = &H8
Private Const LR_LOADFROMFILE     As Long = &H10
Private Const LR_LOADTRANSPARENT  As Long = &H20
Private Const LR_DEFAULTSIZE      As Long = &H40
Private Const LR_LOADMAP3DCOLORS  As Long = &H1000
Private Const LR_CREATEDIBHeader  As Long = &H2000
Private Const LR_COPYFROMRESOURCE As Long = &H4000
Private Const LR_SHARED           As Long = &H8000
 
'Konstanten für SendMessage Msg
Private Const WM_GETICON          As Long = &H7F
Private Const WM_SETICON          As Long = &H80
 
'Konstanten für SendMessage wParam
Private Const ICON_SMALL          As Long = 0
Private Const ICON_BIG            As Long = 1
 
 
Public Sub FormularIconSetzen(hWnd As Long, _
                              IconPfad As String, _
                              Optional TaskIcon As Boolean)
 
   'Quelle: http://www.dbwiki.net/
 
   Dim hIcon As Long
 
   hIcon = LoadImageA(0, IconPfad, IMAGE_ICON, Iconbreite, Iconhöhe, LR_LOADFROMFILE)
 
   If hIcon Then
      SendMessageA hWnd, WM_SETICON, ICON_BIG, ByVal hIcon
      'zusättzlich Icon in der Taskleiste setzen
      If TaskIcon Then
         SendMessageA hWndAccessApp, WM_SETICON, ICON_BIG, ByVal hIcon
      End If
   End If
 
End Sub

Aufruf

  • Icon nur in der Titelleiste des Formulars setzen (Code beim Öffnen des Formulars):
Private Sub Form_Open(Cancel As Integer)
   Call FormularIconSetzen(Me.hWnd, CurrentProject.Path & "\favicon.ico")
End Sub


  • Icon zusätzlich in der Taskleiste setzen (Code beim Öffnen und Aktivieren des Formulars):
Private Sub Form_Open(Cancel As Integer)
   Call FormularIconSetzen(Me.hWnd, CurrentProject.Path & "\favicon.ico", True)
End Sub
 
Private Sub Form_Activate()
   Call FormularIconSetzen(Me.hWnd, CurrentProject.Path & "\favicon.ico", True)
End Sub
Wiki hinweis.png

Anmerkung: Um das eigene Icon auch in der Taskleiste anzuzeigen, muss zusätzlich zum Fenster-Handle des Formulars (Me.hWnd) auch der Fenster-Handle der Application (Application.hWndAccessApp) als Parameter verwendet werden. Da dadurch das Icon nun für die ganze Application (Access-Anwendung) gesetzt wird, muss der Code zusätzlich in das Formularereignis "Form_Activate" gesetzt werden, damit das Icon beim Wechsel durch die Formulare jeweils mit geändert wird.


Wikilinks