Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

1 Ekim 2006 Pazar

Popup Menu 1




'UserForm1

Option Explicit
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare Function CreatePopupMenu Lib "user32" () As Long
Private Declare Function TrackPopupMenuEx Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal hWnd As Long, ByVal lptpm As Any) As Long
Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Const MF_CHECKED = &H8&
Const MF_APPEND = &H100&
Const TPM_LEFTALIGN = &H0&
Const MF_SEPARATOR = &H800&
Const MF_STRING = &H0&
Const TPM_RETURNCMD = &H100&
Const TPM_RIGHTBUTTON = &H2&
Dim hMenu As Long
Dim hWnd As Long
Dim Pt As POINTAPI
Dim ret As Long
Private Sub UserForm_Initialize()
On Error Resume Next
hWnd = FindWindow(vbNullString, Me.Caption)
Me.Caption = "[PBİD®] PopUp Menü1 düzenleme"
End Sub
Private Sub UserForm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
On Error Resume Next
If Button = 2 Then
hMenu = CreatePopupMenu()
AppendMenu hMenu, MF_STRING, 1, "Menü1"
AppendMenu hMenu, MF_STRING, 2, "Menü2"
AppendMenu hMenu, MF_SEPARATOR, 3, ByVal 0&
AppendMenu hMenu, MF_STRING, 4, "[Mustafa ULUSARAÇ] 01ulusarac@superonline.com"
GetCursorPos Pt
ret = TrackPopupMenuEx(hMenu, TPM_LEFTALIGN Or TPM_RETURNCMD Or TPM_RIGHTBUTTON, Pt.X, Pt.Y, hWnd, ByVal 0&)
DestroyMenu hMenu
Select Case ret
Case 1
Call Menü1_Komut
Case 2
Call Menü2_Komut
Case 4
Call Menü3_Komut
End Select
End If
End Sub
Private Sub Menü1_Komut()
On Error Resume Next
MsgBox "PopUp MENÜ1 !"
End Sub
Private Sub Menü2_Komut()
On Error Resume Next
MsgBox "PopUp MENÜ2 !"
End Sub
Private Sub Menü3_Komut()
On Error Resume Next
MsgBox "AÇIKLAMA"
End Sub

Hiç yorum yok:

Blog Arşivi

Bu gadget'ta bir hata oluştu

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul