Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Option Explicit
'//===================================================
'// Routine to Display RightClick Options
'// 28th July 2004
'// After continual crashes & saves!
'//===================================================

'// What we need to do is get the Area to our icon in the TaskBar

'// Types 1st Before InsertMenuItem !
Public Type MENUITEMINFO
    cbSize          As Long
    fMask           As Long
    fType           As Long
    fState          As Long
    wID             As Long
    hSubMenu        As Long
    hbmpChecked     As Long
    hbmpUnchecked   As Long
    dwItemData      As Long
    dwTypeData      As String
    cch             As Long
End Type

Type POINTAPI
        X As Long
        y As Long
End Type

Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

'// Menu
Public Declare Function CreatePopupMenu Lib "user32" () As Long

Public Declare Function InsertMenuItem _
    Lib "user32" _
    Alias "InsertMenuItemA" ( _
        ByVal hMenu As Long, _
        ByVal un As Long, _
        ByVal bool As Long, _
        lpcMenuItemInfo As MENUITEMINFO) _
As Long

Public Declare Function TrackPopupMenuEx _
    Lib "user32" ( _
        ByVal hMenu As Long, _
        ByVal un As Long, _
        ByVal n1 As Long, _
        ByVal n2 As Long, _
        ByVal hwnd As Long, _
        lpTPMParams As Any) _
As Long

Public Declare Function GetCursorPos _
    Lib "user32" ( _
        lpPoint As POINTAPI) _
As Long

'//
Public Declare Function DestroyMenu _
    Lib "user32" ( _
        ByVal hMenu As Long) _
As Long
''
Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long


'// Calls to the functions Menus others added by IFM.
Public Const MF_SEPARATOR = &H800&
Public Const MF_STRING = &H0&
Public Const TPM_RETURNCMD = &H100&
Public Const MIIM_ID = &H2
Public Const MIIM_TYPE = &H10
Public Const MIIM_DATA = &H20

Public PT As POINTAPI
Public lMnu As Long       'RightClick Menu
Public lngMNUItem As Long 'Menu Item selected

Private Const GW_CHILD As Long = 5
Private Const GW_HWNDNEXT As Long = 2

Dim IconRightClickMNU As MENUITEMINFO
'// These variables are used in the
'// Events and procedures for our menu

Sub CreateRightClickMenu()
Dim lngCnt As Long
Dim oMnuItemArray As Range

'// Initialise the MNU constants
Set oMnuItemArray = ThisWorkbook.Sheets(Sheet2.Index).Range("MNU")

lMnu = CreatePopupMenu()

For lngCnt = 1 To 15
    With IconRightClickMNU
        .cbSize = Len(IconRightClickMNU)
        .fMask = MIIM_TYPE Or MIIM_ID Or MIIM_DATA
        .dwTypeData = oMnuItemArray.Item(lngCnt)
        .cch = Len(.dwTypeData)
        If .cch = 1 Then
            .fType = MF_SEPARATOR
        Else
            .fType = MF_STRING
        End If
        .wID = lngCnt
    End With
    Call InsertMenuItem(lMnu, lngCnt, 1, IconRightClickMNU)
Next lngCnt

End Sub

Public Function GetHandleToTray() As Long
'// Get the Handle to the System Tray
Dim lStartWndhdl As Long
Dim lChildWndhdl As Long
Dim strClass As String * 255
Dim lcNameLen As Long

'// Get the handle to the start menu.
lStartWndhdl = FindWindow("Shell_TrayWnd", vbNullString)

'// Get the handle to the first child window of the start menu.
lChildWndhdl = GetWindow(lStartWndhdl, GW_CHILD)

Do
    lcNameLen = GetClassName(lChildWndhdl, strClass, Len(strClass))
    '// Check if it is the Systemtray.
    If InStr(1, strClass, "TrayNotifyWnd") Then
        GetHandleToTray = lChildWndhdl
        Exit Do
    End If
    '// Not found go to the next Child.
    lChildWndhdl = GetWindow(lChildWndhdl, GW_HWNDNEXT)

Loop

End Function