Acquista i nostri libri consigliati su Amazon.it
+ Rispondi al messaggio
Visualizzazione dei risultati da 1 a 5 su 5

Menu popup in tray icon

  1. #1
    Peppe1977 non  in linea Novello
    Buonasera a tutti,

    vorrei ridurre l'esecuzione di Excel in TrayIcon, riesco nell'operazione tramite le API di Windows (il codice l'ho copiato in giro per il web) ma non riesco a visualizzare il men con il tasto destro, ossia se la finestra di progettazione di excel visibile il tasto destro funziona ed il men viene visualizzato, mentre se Excel non visibile in nessuna parte, il suddetto men non viene visualizzato. Vi posto il codice da me usato.

    Questo il codice del UserForm
    Option Explicit
    
    Private Sub CommandButton1_Click() 'riduci in tray
    
    Dim Me_hWnd As Long, Me_Icon As Long, Me_Icon_Handle As Long, IconPath As String
    Me_hWnd = FindWindowd("ThunderDFrame", UserForm1.Caption)
    IconPath = Application.Path & Application.PathSeparator & "excel.exe"
    Me_Icon_Handle = ExtractIcond(0, IconPath, 0)
    Hook Me_hWnd
    AddIconToTray Me_hWnd, 0, Me_Icon_Handle, "Doppio click per riapre la form, singol click col destro per visualizzare il men"
    Me.Hide
    
    End Sub
    
    Private Sub CommandButton2_Click() 'rendi visibile
    
    Application.Visible = True
    Unload Me
    
    End Sub
    
    Private Sub CommandButton3_Click() ' esegue una macro registrata in un altro modulo per copiare dati da internet
    
    Peppe
    
    End Sub
    
    Private Sub UserForm_Activate() ' rimuove la tray quando la form diventa visibile
    
    RemoveIconFromTray
    Unhook
    
    End Sub
    
    Private Sub UserForm_Initialize() ' cambia le caption dei controlli e nasconde excel
    
    CommandButton1.Caption = "Riduci in tray"
    CommandButton2.Caption = "Ritorna a Excel"
    
    End Sub
    
    Questo quello del modulo 'modAPI'
    Option Explicit
    Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
    Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" ( _
    ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
    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 FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName _
    As String, ByVal lpWindowName As String) As Long
    Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst _
    As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
    Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
    
    Private Const WM_LBUTTONDOWN = &H201
    Private Const WM_LBUTTONUP = &H202
    Private Const WM_LBUTTONDBL = &H203
    Private Const WM_RBUTTONDOWN = &H204
    Private Const WM_RBUTTONUP = &H205
    Private Const WM_ACTIVATEAPP = &H1C
    Private Const NIF_ICON = &H2
    Private Const NIF_MESSAGE = &H1
    Private Const NIF_TIP = &H4
    Private Const NIM_ADD = &H0
    Private Const NIM_DELETE = &H2
    Private Const MAX_TOOLTIP As Integer = 64
    Private Const GWL_WNDPROC = (-4)
    
    Type NOTIFYICONDATA
    cbSize As Long
    hWnd As Long
    uID As Long
    uFlags As Long
    uCallbackMessage As Long
    hIcon As Long
    szTip As String * MAX_TOOLTIP
    End Type
    
    Public nfIconData As NOTIFYICONDATA
    
    Private FHandle As Long
    Private WndProc As Long
    Private Hooking As Boolean
    
    
    Public Sub Hook(Lwnd As Long)
    If Hooking = False Then
    FHandle = Lwnd
    WndProc = SetWindowLong(Lwnd, GWL_WNDPROC, AddressOf WindowProc)
    Hooking = True
    End If
    End Sub
    
    Public Sub Unhook()
    If Hooking = True Then
    SetWindowLong FHandle, GWL_WNDPROC, WndProc
    Hooking = False
    End If
    End Sub
    
    Public Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    
    If Hooking Then
        
        Select Case lParam
            Case Is = WM_LBUTTONDBL
                UserForm1.Show
                WindowProc = True
                Exit Function
            Case Is = WM_RBUTTONUP
                Call CreaPopUpMenu
                WindowProc = True ' MsgBox "ciao"
                Exit Function
        End Select
        WindowProc = CallWindowProc(WndProc, hw, uMsg, wParam, lParam)
    End If
    
    End Function
    
    Public Sub RemoveIconFromTray()
    Shell_NotifyIcon NIM_DELETE, nfIconData
    End Sub
    
    Public Sub AddIconToTray(MeHwnd As Long, MeIcon As Long, MeIconHandle As Long, _
    Tip As String)
    With nfIconData
    .hWnd = MeHwnd
    .uID = MeIcon
    .uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
    .uCallbackMessage = WM_RBUTTONUP
    .hIcon = MeIconHandle
    .szTip = Tip & Chr$(0)
    .cbSize = Len(nfIconData)
    End With
    Shell_NotifyIcon NIM_ADD, nfIconData
    End Sub
    
    Function FindWindowd(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    FindWindowd = FindWindow(lpClassName, lpWindowName)
    End Function
    
    Function ExtractIcond(ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal _
    nIconIndex As Long) As Long
    ExtractIcond = ExtractIcon(hInst, lpszExeFileName, nIconIndex)
    End Function
    
    Sub ShowUserForm()
    Application.Visible = False
    UserForm1.Show 1
    End Sub
    
    E questo il codice del modulo 'modMenu'
    Option Explicit
    
    Public Const MioMenu As String = "PopUpMenu"
    
    Sub EliminaPopUpMenu()
        
        On Error Resume Next
        Application.CommandBars(MioMenu).Delete
        On Error GoTo 0
    
    End Sub
    
    Sub CreaPopUpMenu()
        
        Call EliminaPopUpMenu
    
        Call PersonalizzaPopUpMenu
    
        On Error Resume Next
        Application.CommandBars(MioMenu).ShowPopup
        
        On Error GoTo 0
        
    End Sub
    
    Sub PersonalizzaPopUpMenu()
        
        Dim MenuItem As CommandBarPopup
        With Application.CommandBars.Add(Name:=MioMenu, Position:=msoBarPopup, _
                                         MenuBar:=False, Temporary:=True)
    
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "Copia C.Ope"
                .OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro"
            End With
    
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "Riduci in tray"
                .OnAction = "'" & ThisWorkbook.Name & "'!" & "TestMacro"
            End With
    
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "Torna ad Excel"
                .OnAction = "'" & ThisWorkbook.Name & "'!" & "Esci"
            End With
    
        End With
        
    End Sub
    
    Sub TestMacro()
        
        MsgBox "Ciao questa  una prova"
    
    End Sub
    
    Sub Esci()
    
    Application.Visible = True
    Unload UserForm1
    
    End Sub
    
    Aspetto risposte. Grazie.

    Peppe77

  2. #2
    L'avatar di Zer0Kelvin
    Zer0Kelvin non  in linea Scolaretto
    Ciao.
    Se non ho interpretato male il codice, nel tray non ci va Excel, ma la userform; Excel solo invisibile e, che io sappia, se l'applicazione non visibile , non lo sono neanche i menu visualizzati con ShowPopup...
    ℹ️ Leggi di pi su Zer0Kelvin ...

  3. #3
    L'avatar di @Alex
    @Alex non  in linea Moderatore Globale
    A parte SubClassare il VBA che decisamente da EVITARE come la peste, una volta attivato il Subclassing il VBEditor inutilizzabile..., se vuoi attivare i Men non puoi usare poi l'oggetto CommandBar di Excel sulla TryIcon... che legato all'application, quindi non visibile, ma devi generare un Popup API su evento WM_RBUTTONUP

    API Popup Men in poche righe di codice

    Valuta poi la possibilit di EVITARE il SubClassing:
    http://support.microsoft.com/%3Fscid%3D176085

    Se vuoi vedere un Demo con Access dei Popup API lo trovi qu:

    Men Popup

    Scarica il File e rinominalo come RAR, poi lo scompatti, dentro c' un Demo per Axp... trovi una Classe WRAPPER verso le API di gestione dei POPUP che semplifica il lavoro, ti basta unire il SubClassing con il Men, la cosa abbastanza elementare, ma...

    Personalmente lo reputo molto pericoloso questo lavoro...
    Ultima modifica di @Alex; 17-09-2014 08:55 
    ℹ️ Leggi di pi su @Alex ...

  4. #4
    Peppe1977 non  in linea Novello
    Quote Originariamente inviato da @Alex Visualizza il messaggio
    A parte SubClassare il VBA che decisamente da EVITARE come la peste
    Perdona la mia ingnoranza, ma spiegare cos' "SubClassare"? Purtroppo ho fatto un corso di vb nell'ormai lontano 1998, e apparte semplici applicativi non abbiamo approfondito molto il linguaggio di programmazione, insomma stata na cosa shue shue (semplice semplice) come si dice dalle mie parti.

    Ora per motivi legati al lavoro, con un collega, vorremmo velocizzare alcune procedure, noiose e ripetitive, mediante l'utilizzo di vba. Non possiamo usare VB o altri linguaggi poich non abbiamo i diritti da amministratore sui pc utilizzati.

    Ciao

  5. #5
    L'avatar di @Alex
    @Alex non  in linea Moderatore Globale
    Guarda, se tu avessi fatto una ricerca avresti anche trovato questo : SUBCLASSING, che chiaramente rende superfluo un dettaglio.
    Quello su cui tuttavia io rifletterei l'idea di utilizzare tecniche di questo tipo senza avere chiara idea di cosa siano e di cosa comportano...
    ℹ️ Leggi di pi su @Alex ...

+ Rispondi al messaggio

Potrebbero interessarti anche ...

  1. Access - menu popUp
    Da dodo47 nel forum Microsoft Access
    Risposte: 11
    Ultimo Post: 22-01-2012, 19:52
  2. Risposte: 5
    Ultimo Post: 24-02-2011, 14:44
  3. Tray icon
    Da John nel forum Visual Basic 6
    Risposte: 7
    Ultimo Post: 27-03-2007, 10:30
  4. [POPUP MENU] Aggiunta icone
    Da vbrookie nel forum Visual Basic 6
    Risposte: 19
    Ultimo Post: 08-06-2006, 17:53
  5. tray icon
    Da Pacca nel forum Visual Basic 6
    Risposte: 4
    Ultimo Post: 22-05-2006, 16:10