با سلام؛
یه سؤال از دوستان داشتم:
چطور میتوان در یک TextBox موجود در یک UserForm ، خاصیت Right Click را فعال کرد؟
با تشکر
یه سؤال از دوستان داشتم:
چطور میتوان در یک TextBox موجود در یک UserForm ، خاصیت Right Click را فعال کرد؟
با تشکر
-
-
RE: Right Click در TextBox
لطفاً اساتید یه کمکی بکنند. -
RE: Right Click در TextBox
" دوستان ، اساتید ، بچهها " پس یه " جوابی ، کمکی ، چیزی "نوشته اصلی توسط Javad-2010کامنت
-
RE: Right Click در TextBox
هیچ کسی هیچ جوابی برای این سؤال نداره ؟!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!نوشته اصلی توسط Javad-2010کامنت
-
RE: Right Click در TextBox
با دورد فراوان
دوست خوبم اگر توضیح دهید که برای چه منظور میخواهید از راست کلیک استفاده کنی شاید بهتر بتوانم کمک کنم
ولی به هر حال با این کد می توانی با راست کلیک و یا چپ کلید کدی مورد نظر و یا کاری که در نظر داری را انجام دهید
مثال:
Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
MsgBox "Asd"
End Sub---------------------------------------------------------------------------------------------------
بمانیم تا کاری کنیم ،نه کاری کنیم تا بمانیم [size=x-small](دکتر شریعتی)[/size]
shamsololama@yahoo.com
09177733411کامنت
-
RE: Right Click در TextBox
با سلام؛نوشته اصلی توسط shamsololama
در واقع من میخواهم وقتی روی TextBox راستکلیک میکنم، به گزینههای Cut ، Copy ، Paste ، Select All دسترسی داشته باشم. (مثل TextBox موجود در VB6)کامنت
-
RE: Right Click در TextBox
با درود فراوان
با توضیح که فرمودید مسئله فرق کرد برای این کارهای که می خواهید انجام دهید در تکست باکس قرار داده شده اما بصورت کلید میانبر می توانید از آنها استفاده کنید مثلا برای Select All با زدن Ctrl+A و برای کپی و کات و پیست هم همانطور که میدانید از ترکیب کنترل با سی و کنترل با ایکس و کنترل با وی انجام میشه ولی برای اینکه دراگ دروب را در تکست باکس فعال کنید می بایست گزینه rag Behavior مربوط به تکست باکس را فعال کنید که پس از این کار می تواند باانتخاب همه یا قسمتی از متن آن را به وسیله درگ کردن و کشیدن به تکست باکس دیگر آن انتقال دهید
و یک راه هم روی تکست باکس راست کلیک را فعال کنید به اینصورت است که در تکست باکس این کد را بنویسید
Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then
CommandBars("Cell").ShowPopup
End If
End Sub
ولی با اینکار راست کلیک هرچند که روی تکست باکس فعال شده و عمل میکند ولی راست کلیکی باز میشود مربوط به سلی است که در صفحه انتخاب شده و فعال است
---------------------------------------------------------------------------------------------------
بمانیم تا کاری کنیم ،نه کاری کنیم تا بمانیم [size=x-small](دکتر شریعتی)[/size]
shamsololama@yahoo.com
09177733411کامنت
-
RE: Right Click در TextBox
با سلام؛نوشته اصلی توسط shamsololama
خیلی ممنون از جوابتون، با این توضیحات که فرمودید، آیا امکان استفاده از منوی راستکلیک در TextBox های اکسل وجود دارد یا نه؟
خیلی ممنونکامنت
-
RE: Right Click در TextBox
با درود فراواننوشته اصلی توسط Javad-2010
البته راه های که گفتم راحت بود و برای رسیدن به آن چیزی که شما دقیقا همون منظور شماست نیاز به نوشتن تابع هست که من آن را برای شما می نویسم که اگر برای استفاده از آن مشکلی بود بگو و یا تماس بگیر
اول این تابه را در تکست باکس مورد نظر بگذارید و سپس تابع بعدی هم در یک ماژول بنویسد (کپی کنید)
کد:
Private Sub TextBox1_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then
Call ShowPopup(Me, Me.Caption, X, Y)
End If
End Sub
-تابع--------------------------------------------------------------------------------------
Private Declare Function CreatePopupMenu Lib "user32" () As Long
Private Declare Function InsertMenuItem Lib "user32" Alias "InsertMenuItemA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, ByRef lpcMenuItemInfo As MENUITEMINFO) As Long
Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As RECT) As Long
Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private 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
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Const TPM_LEFTALIGN = &H0&
Private Const TPM_TOPALIGN = &H0
Private Const TPM_RETURNCMD = &H100
Private Const TPM_RIGHTBUTTON = &H2&
Private Const MIIM_STATE = &H1
Private Const MIIM_ID = &H2
Private Const MIIM_TYPE = &H10
Private Const MFT_STRING = &H0
Private Const MFT_SEPARATOR = &H800
Private Const MFS_DEFAULT = &H1000
Private Const MFS_ENABLED = &H0
Private Const MFS_GRAYED = &H1
Private Const ID_Cut = 101
Private Const ID_Copy = 102
Private Const ID_Paste = 103
Private Const ID_Delete = 104
Private Const ID_SelectAll = 105
Private FormCaption As String
Private Cut_Enabled As Long
Private Copy_Enabled As Long
Private Paste_Enabled As Long
Private Delete_Enabled As Long
Private SelectAll_Enabled As Long
Public Sub ShowPopup(oForm As UserForm, strCaption As String, X As Single, Y As Single)
Dim oControl As MSForms.TextBox
Static click_flag As Long
click_flag = click_flag + 1
If (click_flag Mod 2 <> 0) Then Exit Sub
Set oControl = oForm.ActiveControl
If X > oControl.Width Or Y > oControl.Height Or X < 0 Or Y < 0 Then Exit Sub
FormCaption = strCaption
Call EnableMenuItems(oForm)
Select Case GetSelection()
Case ID_Cut
oControl.Cut
Case ID_Copy
oControl.Copy
Case ID_Paste
oControl.Paste
Case ID_Delete
oControl.SelText = ""
Case ID_SelectAll
With oControl
.SelStart = 0
.SelLength = Len(oControl.Text)
End With
End Select
End Sub
Private Sub EnableMenuItems(oForm As UserForm)
Dim oControl As MSForms.TextBox
Dim oData As DataObject
Dim testClipBoard As String
On Error Resume Next
Set oControl = oForm.ActiveControl
Set oData = New DataObject
If oControl.SelLength > 0 Then
Cut_Enabled = MFS_ENABLED
Copy_Enabled = MFS_ENABLED
Delete_Enabled = MFS_ENABLED
Else
Cut_Enabled = MFS_GRAYED
Copy_Enabled = MFS_GRAYED
Delete_Enabled = MFS_GRAYED
End If
If Len(oControl.Text) > 0 Then
SelectAll_Enabled = MFS_ENABLED
Else
SelectAll_Enabled = MFS_GRAYED
End If
oData.GetFromClipboard
testClipBoard = oData.GetText
If Err.Number = 0 Then
Paste_Enabled = MFS_ENABLED
Else
Paste_Enabled = MFS_GRAYED
End If
Err.Clear
Set oControl = Nothing
Set oData = Nothing
End Sub
Private Function GetSelection() As Long
Dim menu_hwnd As Long
Dim form_hwnd As Long
Dim oMenuItemInfo1 As MENUITEMINFO
Dim oMenuItemInfo2 As MENUITEMINFO
Dim oMenuItemInfo3 As MENUITEMINFO
Dim oMenuItemInfo4 As MENUITEMINFO
Dim oMenuItemInfo5 As MENUITEMINFO
Dim oMenuItemInfo6 As MENUITEMINFO
Dim oRect As RECT
Dim oPointAPI As POINTAPI
#If VBA6 Then
form_hwnd = FindWindow("ThunderDFrame", FormCaption)
#Else
form_hwnd = FindWindow("ThunderXFrame", FormCaption)
#End If
GetCursorPos oPointAPI
menu_hwnd = CreatePopupMenu
With oMenuItemInfo1
.cbSize = Len(oMenuItemInfo1)
.fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
.fType = MFT_STRING
.fState = Cut_Enabled
.wID = ID_Cut
.dwTypeData = "Cut"
.cch = Len(.dwTypeData)
End With
With oMenuItemInfo2
.cbSize = Len(oMenuItemInfo2)
.fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
.fType = MFT_STRING
.fState = Copy_Enabled
.wID = ID_Copy
.dwTypeData = "Copy"
.cch = Len(.dwTypeData)
End With
With oMenuItemInfo3
.cbSize = Len(oMenuItemInfo3)
.fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
.fType = MFT_STRING
.fState = Paste_Enabled
.wID = ID_Paste
.dwTypeData = "Paste"
.cch = Len(.dwTypeData)
End With
With oMenuItemInfo4
.cbSize = Len(oMenuItemInfo4)
.fMask = MIIM_TYPE
.fType = MFT_SEPARATOR
End With
With oMenuItemInfo5
.cbSize = Len(oMenuItemInfo5)
.fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
.fType = MFT_STRING
.fState = Delete_Enabled
.wID = ID_Delete
.dwTypeData = "Delete"
.cch = Len(.dwTypeData)
End With
With oMenuItemInfo6
.cbSize = Len(oMenuItemInfo6)
.fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
.fType = MFT_STRING
.fState = SelectAll_Enabled
.wID = ID_SelectAll
.dwTypeData = "Select All"
.cch = Len(.dwTypeData)
End With
InsertMenuItem menu_hwnd, 1, True, oMenuItemInfo1
InsertMenuItem menu_hwnd, 2, True, oMenuItemInfo2
InsertMenuItem menu_hwnd, 3, True, oMenuItemInfo3
InsertMenuItem menu_hwnd, 4, True, oMenuItemInfo4
InsertMenuItem menu_hwnd, 5, True, oMenuItemInfo5
InsertMenuItem menu_hwnd, 6, True, oMenuItemInfo6
GetSelection = TrackPopupMenu _
(menu_hwnd, _
TPM_LEFTALIGN Or TPM_TOPALIGN Or TPM_RETURNCMD Or TPM_RIGHTBUTTON, _
oPointAPI.X, oPointAPI.Y, _
0, form_hwnd, oRect)
DestroyMenu menu_hwnd
End Function
---------------------------------------------------------------------------------------------------
بمانیم تا کاری کنیم ،نه کاری کنیم تا بمانیم [size=x-small](دکتر شریعتی)[/size]
shamsololama@yahoo.com
09177733411کامنت
-
RE: Right Click در TextBox
با سلام؛
نه، طبق همان چیزی که فرمودید انجام دادم و مشکلی پیش نیومد.اگر برای استفاده از آن مشکلی بود بگو و یا تماس بگیر
خیلی ممنون، دقیقاً همان چیزی بود که میخواستم.کامنت
کامنت