السلام عليكم
بناء علي طلب احد الاخوه
ولاهمية الموضوع و لسهولة الرجوع اليه تم عمله بموضوع جديد
من محرر الاكواد و في محرر اكواد ThisWorkbook
الصق الكود التالي و هو يقوم بعمل قائمة اسمها Adel بها بندين
كل بند له ماكرو الند الاول aa و البند الثاني bb
Private Sub Workbook_Open()
Dim mnbNew As Menu
Set mnbNew = MenuBars(xlWorksheet).Menus.Add("&Adel")
mnbNew.MenuItems.Add "All&sheets", "aa"
mnbNew.MenuItems.Add "Try Me", "bb"
End Sub
و قم بانشاء مديول جديد و الصق به الكود التالي
Sub aa()
On Error Resume Next
Application.CommandBars("Workbook Tabs").Controls("More Sheets...").Execute
If Err.Number > 0 Then
Err.Clear
Application.CommandBars("Workbook Tabs").ShowPopup
End If
On Error GoTo 0
End Sub
Sub bb()
On Error Resume Next
ActiveSheet.Range("H5") = "Adel.Hanafy"
Columns("H:H").ColumnWidth = 16.43
Range("H5").Select
Selection.Font.Bold = True
Selection.Font.Italic = True
Selection.Font.Underline = xlUnderlineStyleSingle
With Selection.Font
.Name = "Arial"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleSingle
.ColorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.ColorIndex = 5
End Sub
خالص تحياتي
اضافة قائمة في Menu bar.rar