METTRE UNE ICÔNES DANS LA BARRE DE TACHES

A mettre dans un module :

Type NOTIFYICONDATA
    cbSize            As Long
    hwnd                As Long
    uID              As Long
    uFlags            As Long
    uCallbackMessage    As Long
    hIcon              As Long
    szTip              As String * 64
End Type

Public Const NIM_ADD = 0
Public Const NIM_MODIFY = 1
Public Const NIM_DELETE = 2
Public Const NIF_MESSAGE = 1
Public Const NIF_ICON = 2
Public Const NIF_TIP = 4
'
Public Const GWL_WNDPROC = -4
'
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_LBUTTONDBLCLK = &H203
Public Const TPM_RIGHTALIGN = &H8&
'
Public lpPrevWndProc As Long
Public ghWnd As Long
'
Declare Function Shell_NotifyIconA Lib _
    "shell32" (ByVal dwMessage As Long, _
    lpData As NOTIFYICONDATA) As Integer
    
'
'*** Fonctions Windows ***
'
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Declare Function SetMenuDefaultItem Lib "user32" (ByVal hMenu As Long, ByVal uItem As Long, ByVal fByPos As Long) As Long
Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As Any) As Long


'*************************
    

Public Sub IconToTray(frx As Form, msgTip$, Flag As Boolean)
Dim nd    As NOTIFYICONDATA
Dim dMSG  As Long
Dim RetVal  As Integer
'
With nd
    .szTip = msgTip$ & Chr$(0)
    .cbSize = Len(nd)
    .hwnd = frx.hwnd
    .uID = 1
    .uCallbackMessage = WM_LBUTTONDOWN
    .hIcon = frx.Icon
    .uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
End With
'
If Flag Then dMSG = NIM_ADD Else dMSG = NIM_DELETE
RetVal = Shell_NotifyIconA(dMSG, nd)

End Sub
Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If hw = Form1.hwnd Then
   If lParam = WM_LBUTTONDBLCLK Then
        Form1.Show vbModeless
   ElseIf lParam = WM_RBUTTONDOWN Then
           MontrerMenu
   Else
    WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
    End If
Else
    WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End If

End Function

Public Sub HookWindow()
lpPrevWndProc = SetWindowLong(ghWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub Unhookwindow()
Dim RetVal As Long
'
RetVal = SetWindowLong(ghWnd, GWL_WNDPROC, lpPrevWndProc)

End Sub

Public Sub MontrerMenu()
Dim hMenu As Long
Dim hSousMenu As Long
Dim RetVal As Long

'
hMenu = GetMenu(frmMenu.hwnd)
hSousMenu = GetSubMenu(hMenu, 0)
'
SetMenuDefaultItem hSousMenu, 0, True
    With Screen
        w& = (.Width \ .TwipsPerPixelX) * 0.8
        h& = (.Height \ .TwipsPerPixelY)
    End With
    
RetVal = TrackPopupMenu(hSousMenu, TPM_RIGHTALIGN, w&, h&, 0&, frmMenu.hwnd, ByVal 0&)
End Sub




A mettre dans votre form :

    Option Explicit

Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Form_Load()
   ghWnd = Me.hwnd
   HookWindow
   IconToTray Me, "CECI est un Test", True
   Me.Hide
End Sub

Private Sub Form_Unload(Cancel As Integer)
   IconToTray Me, "", False
   Unhookwindow
End Sub