ماکرویی برای غیر فعال کردن راست کلیک فقط در فایل مورد نظر

[taocom52]

با سلام و درود بر اساتید محترم
میخواستم جهت جلوگیری از استفاده کاربر از راست کلیک در صفحه اکسل و زبانه های شیتها ،ماکرویی داشته باشم لذا در مراجعه به سایت جند مورد بودند که استفاده کردم ولی متاسفانه درکل فایلهای اکسل راست کیک از کار افتاده البته گویا این مشکل برای دیگر دوستان نیز پیش آمده ولی نتیجه نهایی را متاسفانه نتونستم پیدا کنم لذا مجبورم دوباره اکسل نصب کنم لذا خواشمند ام ماکرویی بفرمایید که فقط در فایل مورد نظر کار کنه و شورت کاتهای راست کلیک را هم شامل بشه البته آدرسی در سایت برای این موضوع بود که متاسفانه از بین رفته .
بسیار متشکرم

اخطار: این یک موضوع قدیمی است به دلیل قدیمی بودن موضوع، ممکن است برخی فایل های ضمیمه به درستی کار نکنند. لطفا در صورت عدم ضرورت، از بالا آوردن موضوعات قدیمی خودداری نمایید.

[amir_ts]

با سلام
از این کد در شیت دلخواه استفاده کنید.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True
    MsgBox ("متاسفانه راست کليک در اين شيت غير فعال است.")
    End Sub

از این کد هم برای کل شیت ها (workbook) میتونید استفاده کنید.(کد رو باید در thisworkbook قرار بدید.)

Private Sub Workbook_SheetBeforeRightClick _
    (ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Cancel = True
    MsgBox (" متاسفانه در کليه شيت ها راست کليک غير فعال است.")
    End Sub

[taocom52]

متشکرم از جوابتان ، اگر بخواهیم راست کلیک رو زبانه شیتهای دلخواه (زبانه های موجود در پایین صفحه)هم کارنکند چه کنیم؟ و چه راهی هست که کاربر نتواند شیت جدیدی اضافه یا پاک کند؟

[amir_ts]

با سلام
برای مخفی کردن/ نمایش کلیک راست در Sheet Tab از کد های زیر استفاده کنید.

 Sub disablerightclick()
  Application.CommandBars("Ply").Enabled = False
 End Sub
 Sub Ensaberightclick()
  Application.CommandBars("Ply").Enabled = True
 End Sub

برای عدم امکان ایجاد شیت جدید از کد زیر استفاده کنید.

Private Sub Workbook_NewSheet(ByVal Sh As Object)
     
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
         
                 ActiveSheet.Delete
         
        MsgBox "متاسفانه شما قادر به اضافه کردن شيت جديد نميباشيد.", 16
         
                 
                 .DisplayAlerts = True
        .ScreenUpdating = True
    End With
     
End Sub

[taocom52]

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

[amir_ts]

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

[taocom52]

متشکرم