ایجاد shortcut menu با چپ کلیک

[m_bargostavan_66]

سلام دوستان
میخواستم ببینم راه اینکه shortcut menu که درست میکنیم به جای اینکه با کلیک راست فعال بشه، با کلیک چپ فعال بشه
مثلا ما یه button یا یه label داشته باشیم و وقتی روش کلیک کردیم (چپ کلیک ) منو رو نشون بده
هر چی گشتم پیدا نکردم
اگه راهنمایی یا فایل نمونه داشته باشید ممنون میشم

[m_bargostavan_66]

من تو سایت گشتم یه نمونه پیدا کردم و ضمیمه میکنم ، منظورم اینه که کلیک میکنیم منو میاد
ولی نمیدونم چرا انتقال میدم به فایل خودم اجرا نمیشه
تمام کدها و ماکرو ها و فرمها و .... رو هم انتقال میدم به فایل خودم باز هم اجرا نمیشه
آیا ربطی به اکسس 2003 یا 2010 داره؟
لطفا کمک کنید

[m_bargostavan_66]

دوستان ، رفقا ، مهندسین
هیچ کس نمیتونه جواب بده ؟؟؟؟؟؟؟

[m_bargostavan_66]

یک هفته گذشته
واقعا اساتید کسی نمیتونه یه راهنمایی بکنه :متفکر::متفکر:

[mazoolagh]

نمونه ساده خودتون رو آپلود کنین - فقط کدها و ابجکتهای مربوط به پرسش رو نگه دارین.

[m_bargostavan_66]

نمونه ساده خودتون رو آپلود کنین - فقط کدها و ابجکتهای مربوط به پرسش رو نگه دارین.
خیلی ممنون
فایل آپلود کردم
الان با کلیک راست روی ورود به اطلاعات اون منویی که تو ماکرو درست کردم رو نمایش میده
ولی من میخوام با کلیک معمولی روی buttom اون منو رو نشون بده - به عبارت دیگه با کلیک چپ منو رو نشون بده

[mazoolagh]

….... Time

[mazoolagh]

وقتی با ماکرو shortcut menu میسازین فقط میتونین اون رو به یک کنترل یا فرم و ... نسبت بدین و رفتارش از پیش تعیین شده است، یعنی اون ماکرو رو نمیتونین با کد دیگه ای باز کنین (مثلا button click).

البته این گفته در سطح اطلاعات من هست، ممکنه نادرست باشه و راهی براش باشه که از اون بیخبر باشم.

ولی شما میتونین با کد command bar بسازین و به دیتابیس اضافه کنین. این command bar رو دستتون باز هست که چجوری و کجا و کی باز کنین.

چند نکته هست که باید در نظر داشته باشین:
1- بر خلاف shortcut menu که هربار اجرا میشه، command bar در دیتابیس ذخیره میشه و یکبار اجرای کد ساخت کافی هست.
مگر اینکه طراحی اون تغییر کنه که اول باید اون رو حذف و دوباره ایجاد کرد.

2- در این روش دستتون بازتر هست، فرضا میتونین برای هر آیتم منو یک icon بگذارین، اندازه و ظاهرش رو کننرل کنین و از همه مهمتر اینکه یک sub/function رو بهش نسبت بدین.

3- مستندات این کنترل رو از اینجا میتونین بخونین:
https://docs.microsoft.com/en-us/office/vba/api/office.commandbar

[mazoolagh]

اول افزودن رفرنس:
151549

[mazoolagh]

Option Compare Database
Option Explicit
Public Sub CreateMenu()
On Error GoTo Create
Dim CommandBar As Office.CommandBar
Set CommandBar = CommandBars("Menu")
Set CommandBar = Nothing
Exit Sub
Create:
Set CommandBar = CommandBars.Add("Menu", msoBarPopup)
With CommandBar.Controls.Add(msoControlButton)
.Caption = "Form&1"
.OnAction = "=BTN1_Click()"
.FaceId = 501
End With
With CommandBar.Controls.Add(msoControlButton)
.Caption = "Form&2"
.OnAction = "=BTN2_Click()"
.FaceId = 502
End With
With CommandBar.Controls.Add(msoControlButton)
.Caption = "ماشین حساب"
.OnAction = "=BTN3_Click()"
.FaceId = 283
End With
Set CommandBar = Nothing
End Sub

[mazoolagh]

Option Compare Database
Option Explicit
Private Sub CMD1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = acLeftButton Then
CommandBars("Menu").ShowPopup
End If
End Sub
Function BTN1_Click()
DoCmd.OpenForm "Form1"
End Function
Function BTN2_Click()
DoCmd.OpenForm "Form2"
End Function
Function BTN3_Click()
Shell ("calc.exe")
End Function

[mazoolagh]

نتیجه کار:
151551

[mazoolagh]

دیتابیس نمونه

[m_bargostavan_66]

دیتابیس نمونه
سپاسگذارم از راهنمایی تون
دقیقا منظورم همین بود

حالا یه مشکلی که دارم اینه که نمیتونم هیچ تغییری تو این منو ها بدم
مثلا یه آیتم زیاد کنم یا کم کنم
نمونه فایل خودتون رو اصلاح کردم و فرستادم ولی هیچ تغییری صورت نمیگیره

[m_bargostavan_66]

سپاسگذارم از راهنمایی تون
دقیقا منظورم همین بود

حالا یه مشکلی که دارم اینه که نمیتونم هیچ تغییری تو این منو ها بدم
مثلا یه آیتم زیاد کنم یا کم کنم
نمونه فایل خودتون رو اصلاح کردم و فرستادم ولی هیچ تغییری صورت نمیگیره
من بعد از تغییرات اومدم اسم menu رو به یه اسم دیگه تغییر دادم و run کردم درست شد
ولی یه مشکلی که الان دارم اینه که وقتی فرم رو تو حالت Pop Up و Modal رو Yes میزارم منوها باز میشه ولی دستورات رو اجرا نمیکنه

[mazoolagh]

لازم نیست اسم منو رو تغییر بدین - مورد 1 رو که دوباره با دقت بخونین!
اینجوری به ازای هر تغییر مجبورین یک اسم جدید انتخاب و کدهای فرم رو هم عوض کنین.
اگر طراحی commandbar رو تغییر بدین باید اول اون رو از دیتابیس حذف و دوباره بسازین.
commandbars("menu").delete

کار خوبی نیست، ولی میتونین در همون روتین createmenu اول کامندبار رو حذف کنین،
و حالا در form open اون رو اجرا کنین.
اینجوری مطمئن هستین که تغییرات همیشه دیده میشه ولی این ایراد رو داره که کد غیرضروری اجرا میشه.

[mazoolagh]

ولی یه مشکلی که الان دارم اینه که وقتی فرم رو تو حالت Pop Up و Modal رو Yes میزارم منوها باز میشه ولی دستورات رو اجرا نمیکنه
بله،
این مورد هست و فعلا چیزی به ذهنم نمیرسه

[m_bargostavan_66]

بله،
این مورد هست و فعلا چیزی به ذهنم نمیرسه
خیلی ممنون بابت وقتی که گذاشتید و جواب من رو دادید کلید تشکر نیست که بزنم

یه راه حلی پیدا کردم که فانکیشن هایی رو که تو فرم هست رو انتقال باید داد به همون ماژولی که نوشته اونجوری دستورات اجرا میشه




Option Compare Database
Option Explicit
Public Sub CreateMenu()

'برای حذف منو ایجاد شده در صورت نیاز
commandbars("menu").delete

'برای ایجاد منو
On Error GoTo Create
Dim CommandBar As Office.CommandBar
Set CommandBar = CommandBars("Menu")
Set CommandBar = Nothing
Exit Sub
Create:
Set CommandBar = CommandBars.Add("Menu", msoBarPopup)
With CommandBar.Controls.Add(msoControlButton)
.Caption = "Form&1"
.OnAction = "=BTN1_Click()"
.FaceId = 501
End With
With CommandBar.Controls.Add(msoControlButton)
.Caption = "Form&2"
.OnAction = "=BTN2_Click()"
.FaceId = 502
End With
With CommandBar.Controls.Add(msoControlButton)
.Caption = "ماشین حساب"
.OnAction = "=BTN3_Click()"
.FaceId = 283
End With
Set CommandBar = Nothing
End Sub

'دستورات آیتم های منو ایجاد شده
Function BTN1_Click()
DoCmd.OpenForm "Form1"
End Function
Function BTN2_Click()
DoCmd.OpenForm "Form2"
End Function
Function BTN3_Click()
Shell ("calc.exe")
End Function

[m_bargostavan_66]

دوست عزیز حالا که زحمت کشیدید
میتونید بگید اگه بخوام مثلا آیتم form2 خودش یه زیرمنو دیگه داشته باشه که شامل مثلا 2 تا زیر منو دیگه باشه چه کدی رو باید بنویسم

[eb_1345]

دوست عزیز حالا که زحمت کشیدید
میتونید بگید اگه بخوام مثلا آیتم form2 خودش یه زیرمنو دیگه داشته باشه که شامل مثلا 2 تا زیر منو دیگه باشه چه کدی رو باید بنویسم

سلام
از نمونه ضمیمه استفاده کن

[mazoolagh]

خیلی ممنون بابت وقتی که گذاشتید و جواب من رو دادید کلید تشکر نیست که بزنم

یه راه حلی پیدا کردم که فانکیشن هایی رو که تو فرم هست رو انتقال باید داد به همون ماژولی که نوشته اونجوری دستورات اجرا میشه


متقابلا بخاطر باشتراک گذاشتن راه حل و کدها از شما ممنونم.
بر مبنای همین، برنامه رو ویرایش و دوباره پیوست میکنم.

[mazoolagh]

Option Compare Database
Option Explicit
Public Sub CreateMenu()
On Error Resume Next
CommandBars("Menu").Delete
On Error GoTo Error_Handler:
Dim CommandBar As Office.CommandBar
Set CommandBar = CommandBars.Add("Menu", msoBarPopup)
With CommandBar.Controls.Add(msoControlButton)
.Caption = "Form&1"
.OnAction = "=BTN1_Click()"
.FaceId = 501
End With
With CommandBar.Controls.Add(msoControlButton)
.Caption = "Form&2"
.OnAction = "=BTN2_Click()"
.FaceId = 502
End With
With CommandBar.Controls.Add(msoControlButton)
.Caption = "ماشین حساب"
.OnAction = "=BTN3_Click()"
.FaceId = 283
End With
Set CommandBar = Nothing
Exit Sub
Error_Handler:
MsgBox Err.Description, vbCritical, Err.Number
End Sub
Public Function BTN1_Click()
DoCmd.OpenForm "Form1"
End Function
Public Function BTN2_Click()
DoCmd.OpenForm "Form2"
End Function
Public Function BTN3_Click()
Shell ("calc.exe")
End Function

[mazoolagh]

Option Compare Database
Option Explicit
Private Sub CMD1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = acLeftButton Then
CommandBars("Menu").ShowPopup
End If
End Sub
Private Sub Form_Open(Cancel As Integer)
CreateMenu
End Sub

[mazoolagh]

دوست عزیز حالا که زحمت کشیدید
میتونید بگید اگه بخوام مثلا آیتم form2 خودش یه زیرمنو دیگه داشته باشه که شامل مثلا 2 تا زیر منو دیگه باشه چه کدی رو باید بنویسم

میتونین از یک commandbar دیگه استفاده و در onaction اون رو باز کنین، ولی با این روش هر دو همزمان نمیتونن باز باشن!
برنامه نمونه پست 20 رو هم یک نگاه بندازین.
من دقیق کدهاش رو بررسی نکردم چون از توایع api استفاده شده و بالشخصه تا حد امکان اونها رو بکار نمیگیرم.

[m_bargostavan_66]

میتونین از یک commandbar دیگه استفاده و در onaction اون رو باز کنین، ولی با این روش هر دو همزمان نمیتونن باز باشن!
برنامه نمونه پست 20 رو هم یک نگاه بندازین.
من دقیق کدهاش رو بررسی نکردم چون از توایع api استفاده شده و بالشخصه تا حد امکان اونها رو بکار نمیگیرم.
نمیدونم منظورم رسوندم یا نه
ولی منظورم مثل عکس زیر هست
کدهایی که شما نوشتین خیلی کمتر و ساده تر هستش

[mazoolagh]

بله، منظور شما رو متوجه شدم.
خواسته شما اسمش cascading menu (منو آبشاری) هست.

ولی دیروز به یک نکته توجه نکرده بودم که برای level های بعدی میتونیم از controlpopup استفاده کنیم (بجای barpopup)

[mazoolagh]

151577
151578

[mazoolagh]

Option Compare Database
Option Explicit
Public Sub CreateMenu()
On Error Resume Next
CommandBars("Menu").Delete
On Error GoTo Error_Handler:
Dim CommandBar As Office.CommandBar
Set CommandBar = CommandBars.Add("Menu", msoBarPopup)
Dim PopBar1, PopBar2 As Office.CommandBarPopup
Set PopBar1 = CommandBar.Controls.Add(msoControlPopup)
PopBar1.Caption = "Forms"
With PopBar1.Controls.Add(msoControlButton)
.Caption = "Form&1"
.OnAction = "=BTN1_Click()"
.FaceId = 501
End With
With PopBar1.Controls.Add(msoControlButton)
.Caption = "Form&2"
.OnAction = "=BTN2_Click()"
.FaceId = 502
End With
With CommandBar.Controls.Add(msoControlButton)
.Caption = "ماشین حساب"
.OnAction = "=BTN3_Click()"
.FaceId = 283
End With
Set PopBar1 = CommandBar.Controls.Add(msoControlPopup)
PopBar1.Caption = "Utils"
Set PopBar2 = PopBar1.Controls.Add(msoControlPopup)
PopBar2.Caption = "Level2"
With PopBar2.Controls.Add(msoControlButton)
.Caption = "Item1"
End With
With PopBar2.Controls.Add(msoControlButton)
.Caption = "Item2"
End With
With PopBar2.Controls.Add(msoControlButton)
.Caption = "Item3"
End With
Set PopBar1 = Nothing
Set PopBar2 = Nothing
Set CommandBar = Nothing
Exit Sub
Error_Handler:
MsgBox Err.Description, vbCritical, Err.Number
End Sub
Public Function BTN1_Click()
DoCmd.OpenForm "Form1"
End Function
Public Function BTN2_Click()
DoCmd.OpenForm "Form2"
End Function
Public Function BTN3_Click()
Shell ("calc.exe")
End Function

[mazoolagh]

برنامه جدید:

[atf1379]

برنامه جدید:
عالی مثل همیشه :تشویق::تشویق::تشویق:
اگه منوها قابلیت راست به چپ شدن داشت خیلی عالی میشد

[m_bargostavan_66]

برنامه جدید:
دمت گرم مهندس ، فوق العاده بود سپاس بیکران:تشویق::تشویق::تشویق:

[mazoolagh]

عالی مثل همیشه :تشویق::تشویق::تشویق:
اگه منوها قابلیت راست به چپ شدن داشت خیلی عالی میشد

برنامه پست شماره 20 رو که یکی از کاربران گرامی پیوست کردن نگاه کنین،
احتمالا با اون برنامه بتونین یک کارهایی بکنین چون فکر کنم انتخاب موقعیت منوها دست شماست.

[atf1379]

سلام
از نمونه ضمیمه استفاده کن

سلام بر اساتید
در نمونه ای که آقای بهرامی ضمیمه نموده ان فرمی قرار دارد که در قسمت بالای آن سه لیبل ایجاد شده که با کلیک بر روی هر لیبل منوی شناوری باز میشود . سوال اینست که آیا با توجه به کدهای مربوطه میتوان نسبت به درج آیکون برای منوها اقدام نمود ؟
و یک سوال دیگر اینکه آیا در اینجور منوها بجای استفاده از آیکون های پیشفرض که با شماره مشخص میشوند میتوان از آیکون های سفارشی یا آیکون هائی که در ابزار ImageList اضافه میشوند استفاده کرد؟
با تشکر