Excel 2003 Style Menu in Excel 2007/2010

[Yasser Fathi Albanna]

السلام عليكم ورحمة الله وبركاته

إخوانى وحبائى أعضاء وأساتذة هذا المنتدى العظيم

تحية طيبة وبعد

وكل عام وحضراتكم بألف خير بمناسبة عيد الأضحى المبارك أعاده الله عليكم بالخير واليمن والبركات

أقدم لكم اليوم أدة Add-in  تقوم بتحويل قوائم الإكسيل 2007 و 2010 إلى قوائم إكسيل 2003

الكود المستخدم

Sub Show_Excel_2003_Style_Menu()
    On Error Resume Next
    Dim cmdBar As CommandBar
    Dim cmdBarCtrl As CommandBarControl
    Dim sMenuName As String
    Dim sToolbarName As String
    Dim iMenu As Integer

    sMenuName = "Excel 2003 Style Menu"
    sToolbarName = "Excel 2003 Style Toolbar"
    CommandBars(sMenuName).Delete
    CommandBars(sToolbarName).Delete
    'Code upto here can be used to hide/delete Excel 2003
    'style menu from Excel 2007/2010.
  
    Set cmdBar = CommandBars.Add(sMenuName, , , True)

    'This will create Excel 2003 style menu bar in Excel 2007/2010
    With cmdBar
        .Visible = True
        For iMenu = 1 To 10
            Set cmdBarCtrl = .Controls.Add(Type:=msoControlPopup, ID:=30001 + iMenu)
        Next iMenu
        Set cmdBarCtrl = .Controls.Add(Type:=msoControlPopup, ID:=30022) 'Chart
        Set cmdBarCtrl = .Controls.Add(Type:=msoControlPopup, ID:=30177) 'AutoShapes
    End With


    Set cmdBar = CommandBars.Add(sToolbarName, , , True)
    With cmdBar
        .Visible = True
        With .Controls
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=2520) 'New
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=23) 'Open
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=3) 'Save
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=4) 'Print
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=109) 'Print Preview
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=2) 'Spelling
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=21) 'Cut
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=19) 'Copy
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=22) 'Paste
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=108) 'Format Painter
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=210) 'Sort Ascending
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=211) 'Sort Descending
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=984) 'Help
            Set cmdBarCtrl = .Add(Type:=msoControlComboBox, ID:=1728) 'Font
            Set cmdBarCtrl = .Add(Type:=msoControlComboBox, ID:=1731) 'Font Size
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=113) 'Bold
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=114) 'Italic
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=115) 'Underline
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=120) 'Align Left
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=122) 'Center
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=121) 'Align Right
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=402) 'Merge and Center
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=395) 'Accounting Number Format
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=396) 'Percent Style
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=397) 'Comma Style
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=398) 'Increase Decimal
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=399) 'Decrease Decimal
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=3162) 'Decrease Indent
            Set cmdBarCtrl = .Add(Type:=msoControlButton, ID:=3161) 'Increase Indent
        End With
    End With
    Set cmdBar = Nothing
    Set cmdBarCtrl = Nothing
    On Error GoTo 0
End Sub

أرجو ا من الله أن ينول رضاكم

Excel2003_Style_Menu.rar

[هانى حرحش]

جزاكم اله خيرا ... ولكن كيف يعمل هذا الكود او الااضافة

 

[Yasser Fathi Albanna]

اخى الفاضل / هانى حرحش

فى البداية كل عام وأنتم بخير

ثم أدخل على بارتشن C ثم Program Files ثم Microsoft Office ثم Office14 ثم XLSTART وفك ضغط الملف المرفق وضعه بهذا XLSTART

ثم إدخل على إعدادات الإكسيل

وإتبع الصور المرفقة

ستجد الأداه ظهرت ضمن إختيارت أخر صورة قم بتظليلها وإضغط OK

 

 

 

Picture.rar

[عبد العزيز البسكري]

السلام عليكم و رحمة الله و بركاته

بارك الله فيك أستاذنا العزيز ياسر فتحي البنّا على إطلالاتك المميّزة .. تميّز صاحبها بالابداعات الجديدة و المبتكرة .. جزاك الله خيرًا و زادها بميزان حسناتك

 

[Yasser Fathi Albanna]

اخى الحبيب الغالى أ / عبد العزيز البسكري

يسعدنى ويشرفنى دائما مرورك الكريم على موضوعاتى

شكرا على كلماتك الطيبة والرائعة

جزاك الله خيرا