{"id":218,"date":"2018-09-27T00:04:16","date_gmt":"2018-09-26T21:04:16","guid":{"rendered":"http:\/\/www.cuneytbayrak.com\/?p=218"},"modified":"2025-02-21T00:04:34","modified_gmt":"2025-02-20T21:04:34","slug":"vba-sag-klik-acilan-menu","status":"publish","type":"post","link":"http:\/\/www.cuneytbayrak.com\/?p=218","title":{"rendered":"VBA Sa\u011f Klik A\u00e7\u0131lan Men\u00fc"},"content":{"rendered":"

\u00d6ncelikle a\u015fa\u011f\u0131da ki \u201chwnd\u201d fonksiyonlar\u0131n\u0131 kodlar\u0131na eklemeniz icap eder.<\/p>\n

\n
Private Declare Function CallNextHookEx Lib \"user32\" (ByVal hHook As Long, _\r\nByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long\r\n \r\nPrivate Declare Function GetModuleHandle Lib \"kernel32\" Alias _\r\n\"GetModuleHandleA\" (ByVal lpModuleName As String) As Long\r\n \r\nPrivate Declare Function SetWindowsHookEx Lib \"user32\" Alias \"SetWindowsHookExA\" _\r\n(ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _\r\nByVal dwThreadId As Long) As Long\r\n \r\nPrivate Declare Function UnhookWindowsHookEx Lib \"user32\" (ByVal hHook As Long) As Long\r\n \r\nPrivate Declare Function SendDlgItemMessage Lib \"user32\" Alias \"SendDlgItemMessageA\" _\r\n(ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _\r\nByVal wParam As Long, ByVal lParam As Long) As Long\r\n \r\nPrivate Declare Function GetClassName Lib \"user32\" Alias \"GetClassNameA\" _\r\n(ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long\r\n \r\nPrivate Declare Function GetCurrentThreadId Lib \"kernel32\" () As Long\r\n \r\n'~~> Constants to be used in our API functions\r\nPrivate Const EM_SETPASSWORDCHAR = &HCC\r\nPrivate Const WH_CBT = 5\r\nPrivate Const HCBT_ACTIVATE = 5\r\nPrivate Const HC_ACTION = 0\r\n \r\nPrivate hHook As Long\r\n \r\nPublic Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, _\r\nByVal lParam As Long) As Long\r\nDim RetVal\r\nDim strClassName As String, lngBuffer As Long\r\n \r\nIf lngCode < HC_ACTION Then\r\nNewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)\r\nExit Function\r\nEnd If\r\n \r\nstrClassName = String$(256, \" \")\r\nlngBuffer = 255\r\n \r\nIf lngCode = HCBT_ACTIVATE Then\r\nRetVal = GetClassName(wParam, strClassName, lngBuffer)\r\n'~~> Class name of the Inputbox\r\nIf Left$(strClassName, RetVal) = \"#32770\" Then\r\n'~~> This changes the edit control so that it display the password character *.\r\n'~~> You can change the Asc(\"*\") as you please.\r\nSendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc(\"*\"), &H0\r\nEnd If\r\nEnd If\r\n \r\n'~~> This line will ensure that any other hooks that may be in place are\r\n'~~> called correctly.\r\nCallNextHookEx hHook, lngCode, wParam, lParam\r\n \r\nEnd Function\r\n \r\nPublic Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _\r\nOptional YPos, Optional HelpFile, Optional Context) As String\r\nDim lngModHwnd As Long, lngThreadID As Long\r\nlngThreadID = GetCurrentThreadId\r\nlngModHwnd = GetModuleHandle(vbNullString)\r\nhHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)\r\nInputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)\r\nUnhookWindowsHookEx hHook\r\nEnd Function<\/pre>\n<\/div>\n
Sonras\u0131nda \u201cUserForm_Initialize\u201d olay\u0131na \u015fu kodu yazman\u0131z gerekir.<\/p>\n
\n
Private Sub UserForm_Initialize()\r\nhwnd = FindWindow(vbNullString, Me.Caption)\r\nEnd Sub<\/pre>\n<\/div>\n
Sonras\u0131nda UserFormunuzun kodlar\u0131 i\u00e7erisine a\u015fa\u011f\u0131da ki kodlar\u0131 ilave etmeniz de gerekiyor.<\/p>\n
\n
Private Type POINTAPI\r\nx As Long\r\ny As Long\r\nEnd Type\r\n'\r\nPrivate Declare Function CreatePopupMenu Lib \"user32\" () As Long\r\nPrivate Declare Function TrackPopupMenuEx Lib \"user32\" _\r\n(ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, _\r\nByVal hwnd As Long, ByVal lptpm As Any) As Long\r\nPrivate Declare Function AppendMenu Lib \"user32\" Alias \"AppendMenuA\" _\r\n(ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, _\r\nByVal lpNewItem As Any) As Long\r\nPrivate Declare Function DestroyMenu Lib \"user32\" (ByVal hMenu As Long) As Long\r\nPrivate Declare Function GetCursorPos Lib \"user32\" (lpPoint As POINTAPI) As Long\r\nPrivate Declare Function FindWindow Lib \"user32\" Alias \"FindWindowA\" _\r\n(ByVal lpClassName As String, ByVal lpWindowName As String) As Long\r\n'\r\nConst MF_CHECKED = &H8&\r\nConst MF_APPEND = &H100&\r\nConst TPM_LEFTALIGN = &H0&\r\nConst MF_SEPARATOR = &H800&\r\nConst MF_STRING = &H0&\r\nConst TPM_RETURNCMD = &H100&\r\nConst TPM_RIGHTBUTTON = &H2&\r\n'\r\nDim hMenu As Long\r\nDim hwnd As Long<\/pre>\n<\/div>\n
Sonras\u0131nda sa\u011f klik yapmak istedi\u011finiz userform kontrol nesnenizin \u201cMouseUp\u201d olay\u0131na a\u015fa\u011f\u0131da ki kodlar\u0131 yaz\u0131n. (Benim uygulamamda \u201clsthm\u201d adl\u0131 listbox\u2019a sa\u011f klik yapt\u0131m.)<\/p>\n
\n
Private Sub lsthm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)\r\n \r\nFor i = 1 To lsthm.ListCount\r\nIf lsthm.Selected(i) = True Then\r\n \r\nDim Pt As POINTAPI\r\nDim ret As Long\r\nIf Button = 2 Then\r\nhMenu = CreatePopupMenu()\r\nAppendMenu hMenu, MF_STRING, 1, \"Kontrol Edildi Olarak Ata\"\r\n' AppendMenu hMenu, MF_STRING, 2, \"Menu - 2\"\r\n' AppendMenu hMenu, MF_SEPARATOR, 3, ByVal 0&\r\n' AppendMenu hMenu, MF_STRING, 4, \"About\"\r\nGetCursorPos Pt\r\nret = TrackPopupMenuEx(hMenu, TPM_LEFTALIGN Or TPM_RETURNCMD Or TPM_RIGHTBUTTON, Pt.x, Pt.y, hwnd, ByVal 0&)\r\nDestroyMenu hMenu\r\n \r\n \r\nSelect Case ret\r\nCase 1\r\nCall MenuProc1\r\nCase 2\r\nCall MenuProc2\r\nCase 4\r\nCall MenuProc3\r\nEnd Select\r\nEnd If\r\n \r\nEnd If\r\nNext\r\n \r\nEnd Sub<\/pre>\n<\/div>\n
MenuProc kodlar\u0131 ise \u015funlar olmal\u0131;<\/p>\n
\n
Private Sub MenuProc1()\r\n \r\nDim y As Integer\r\nDim x As String\r\n \r\ny = Sheets(\"dbalim\").Range(\"n2\").End(xlDown).Row\r\n \r\nx = InputBoxDK(\"Bu i\u015flem i\u00e7in y\u00f6netici \u015fifrenizi girmeniz gerekmektedir!\", \"Y\u00f6netici \u015eifre Giri\u015f Ekran\u0131\")\r\n \r\nIf x = \"\" Then\r\nExit Sub\r\nEnd If\r\n \r\nIf x = \"buraya belirledi\u011finiz bir \u015fifre yaz\u0131n\" Then\r\nSheets(\"dbalim\").Range(\"n\" & y + 1).Value = lsthm.List(lsthm.ListIndex, 0)\r\nSheets(\"dbalim\").Range(\"o\" & y + 1).Value = 1\r\nSheets(\"dbalim\").Range(\"n\" & y + 1).Font.Color = -16776961\r\nSheets(\"dbalim\").Range(\"o\" & y + 1).Font.Color = -16776961\r\n \r\nlsthm.Clear\r\n \r\nWith Me.lsthm\r\nMe.lsthm.ColumnCount = 6\r\nMe.lsthm.ColumnWidths = \"50;90;60;30;50;30\"\r\n.AddItem\r\n.List(0, 0) = \"ID\"\r\n.List(0, 1) = \"\u00dcr\u00fcn\"\r\n.List(0, 2) = \"Firma\"\r\n.List(0, 3) = \"Miktar\"\r\n.List(0, 4) = \"\u0130rsaliye No\"\r\n.List(0, 5) = \"Birim\"\r\n \r\nEnd With\r\n \r\nDim lsthmd As Integer\r\n \r\nlsthmd = Sheets(\"dbalim\").Range(\"a2\").End(xlDown).Row\r\n \r\nFor kntszhm = 2 To lsthmd\r\n \r\nIf Sheets(\"dbalim\").Range(\"K\" & kntszhm).Value = \"\" And Sheets(\"dbalim\").Range(\"L\" & kntszhm).Value <> \"NONE\" Then\r\n \r\nlsthm.AddItem Sheets(\"dbalim\").Range(\"A\" & kntszhm).Value\r\nlsthm.List(lsthm.ListCount - 1, 1) = Sheets(\"dbalim\").Range(\"C\" & kntszhm).Value\r\nlsthm.List(lsthm.ListCount - 1, 2) = Sheets(\"dbalim\").Range(\"G\" & kntszhm).Value\r\nlsthm.List(lsthm.ListCount - 1, 3) = Sheets(\"dbalim\").Range(\"D\" & kntszhm).Value\r\nlsthm.List(lsthm.ListCount - 1, 4) = Sheets(\"dbalim\").Range(\"I\" & kntszhm).Value\r\nlsthm.List(lsthm.ListCount - 1, 5) = Sheets(\"dbalim\").Range(\"J\" & kntszhm).Value\r\n \r\nEnd If\r\n \r\nNext\r\nMsgBox \"\u0130\u015flem Tamamlanm\u0131\u015ft\u0131r!\"\r\nEnd If\r\nIf x <> \"\" And x <> \"belirledi\u011finiz \u015fifre\" Then\r\nMsgBox \"Hatal\u0131 \u015fifre giri\u015fi!\"\r\nExit Sub\r\nEnd If\r\n \r\nEnd Sub\r\n'\r\nPrivate Sub MenuProc2()\r\nMsgBox \"PopUp menu-2 is activated !\"\r\nEnd Sub\r\n'\r\nPrivate Sub MenuProc3()\r\nMsgBox \"PopUp menu-3 is activated !\"\r\nEnd Sub<\/pre>\n<\/div>\n
Kolay gele…<\/p>\n","protected":false},"excerpt":{"rendered":"
\u00d6ncelikle a\u015fa\u011f\u0131da ki \u201chwnd\u201d fonksiyonlar\u0131n\u0131 kodlar\u0131na eklemeniz icap eder. Private Declare Function CallNextHookEx Lib “user32” (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As…<\/p>\n
Devam\u0131n\u0131 OkuVBA Sa\u011f Klik A\u00e7\u0131lan Men\u00fc<\/span><\/a><\/div>\n","protected":false},"author":1,"featured_media":0,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"iawp_total_views":0,"footnotes":""},"categories":[5],"tags":[69],"class_list":["post-218","post","type-post","status-publish","format-standard","hentry","category-excel-vba","tag-rightclickmenu","excerpt"],"_links":{"self":[{"href":"http:\/\/www.cuneytbayrak.com\/index.php?rest_route=\/wp\/v2\/posts\/218","targetHints":{"allow":["GET"]}}],"collection":[{"href":"http:\/\/www.cuneytbayrak.com\/index.php?rest_route=\/wp\/v2\/posts"}],"about":[{"href":"http:\/\/www.cuneytbayrak.com\/index.php?rest_route=\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"http:\/\/www.cuneytbayrak.com\/index.php?rest_route=\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"http:\/\/www.cuneytbayrak.com\/index.php?rest_route=%2Fwp%2Fv2%2Fcomments&post=218"}],"version-history":[{"count":1,"href":"http:\/\/www.cuneytbayrak.com\/index.php?rest_route=\/wp\/v2\/posts\/218\/revisions"}],"predecessor-version":[{"id":220,"href":"http:\/\/www.cuneytbayrak.com\/index.php?rest_route=\/wp\/v2\/posts\/218\/revisions\/220"}],"wp:attachment":[{"href":"http:\/\/www.cuneytbayrak.com\/index.php?rest_route=%2Fwp%2Fv2%2Fmedia&parent=218"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"http:\/\/www.cuneytbayrak.com\/index.php?rest_route=%2Fwp%2Fv2%2Fcategories&post=218"},{"taxonomy":"post_tag","embeddable":true,"href":"http:\/\/www.cuneytbayrak.com\/index.php?rest_route=%2Fwp%2Fv2%2Ftags&post=218"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}