ایجاد 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/off...ice.commandbar

[mazoolagh]

اول افزودن رفرنس:
1.PNG

[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]

نتیجه کار:
2.png

[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]

3.jpg
4.jpg

[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 رو که یکی از کاربران گرامی پیوست کردن نگاه کنین،
احتمالا با اون برنامه بتونین یک کارهایی بکنین چون فکر کنم انتخاب موقعیت منوها دست شماست.