Soru Listbox üzerinde silme

sirkülasyon

Altın Üye
Katılım
10 Temmuz 2012
Mesajlar
2,532
Excel Vers. ve Dili
2021 LTSC TR
Altın Üyelik Bitiş Tarihi
18-06-2026
Ustam
Listboxta yer alan personel ismini seçtikten sonra sağ tuş ile SİL butonu oluşturup da hem sayfadan hem de listboxtan silebiliriz miyiz?
Böyle bir imkan olabilir ise kod için yardımcı olabilir misiniz?
 

Mahmut Bayram

Özel Üye
Katılım
25 Haziran 2005
Mesajlar
1,778
Excel Vers. ve Dili
2021 Excel Tr
Bunu bir dene kardeş. (listboxa veri alan kodları ve sil kodlarını eklemeniz gerekiyor)

Kod:
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
Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal y As Single)
If Button <> 2 Then Exit Sub
Dim Pt As POINTAPI
Dim ret As Long
hMenu = CreatePopupMenu()
AppendMenu hMenu, MF_STRING, 1, "Delete This Row On ListBox1 and ListBox2"
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 Delete_This_Rows
End Select
End Sub

Private Sub Delete_This_Rows()
MsgBox "Buraya ilgili satırı bulup silen kod yazılabilir."
End Sub

Private Sub UserForm_Initialize()
hWnd = FindWindow(vbNullString, Me.Caption)
End Sub
 
Üst