بعض مواد القائمة المختصرة تظهر في accdb ولا تظهر في mdb

[أحمد العيسى]

في 8‏/6‏/2026 at 00:20, jjafferr said:

بدلا عن هذا الشريط ، اليكم طريقة اسهل في التعامل

 

بالاشارة الى المشاركة:

 

 

فعلاً  .. من أسهل ما يمكن

وبطريقة ما  أضفت هذا الشريط إلى تقارير ملف عندي بصيغة mdb

لأننى أقوم بتشغيله على كافة إصدارات الأكسس من 2003 إلى 2024

 

فى الإصدار 2007  ممتاز  ، تم ظهور  وتمكين جميع محتوياته

 

فى الإصدار  2003  ، للأسف بعض محتوياته الهامة أصبحت غير متاحة

 

 

 

Shortcut Menu.mdb

[jjafferr]

وعليكم السلام اخي احمد

 

ولكوني لا املك اكسس 2003 ، فقد اعطيتك اقتراح من احد المواقع ، 

ولكن صادفت بعض الامور الاخرى البارحة (لا علاقة لها بهذا الكود) ، فأعدت التفكير مرة اخرى ، واليك النتيجة:

جميع هذه الاوامر هي جزء من الاكسس ، فإذا مو موجودة في الاكسس ، فلن تعمل وستجدها باللون الرمادي (مثل التصدير الى PDF والتي لا توجد في اكسس 2003) ، ولاحظت اني لما فتحت التقرير بوضع Report View ، فاصبح امر close في القائمة رمادي ، فهاذ معناه ان الاكسس يعتبر هذا الوضع وضع نموذج وليس وضع تقرير !!

 

عليه طلبت من الذكاء الاصطناعي ، فاعطاني هذه الدالة حتى تعمل على الصيغتين mdb و accdb ، وهي تعتمد في عملها على التأكد من صيغة البرنامج mdb او accdb ، فهذا معناه ان الدالة لا تكون ثابته (لا تحتاج الى الكود بعد تصنيعها) ، وانما هي مؤقته وتعمل كل مرة تشغل فيها الدالة :

Public Function SCM_Zoom_Pages_Print_Export_TEMPORARY()
    Dim cmbName As String
    Dim cmb As Object
    Dim cmbCtrl As Object
    
    ' Variable IDs to handle MDB vs ACCDB compatibility
    Dim idQuickPrint As Long
    Dim idPrintDialog As Long
    Dim idExportWord As Long
    Dim idExportExcel As Long
    Dim idClose As Long
    
    On Error Resume Next 'If menu with same name exists delete
    cmbName = "rpt_Zoom_Pages_Print_Export_TEMPORARY"
    CommandBars(cmbName).Delete
    If Err.Number <> 0 Then Err.Clear
    On Error GoTo 0
     
    ' Determine Control IDs based on file format (MDB < 12, ACCDB >= 12)
    If CurrentProject.FileFormat < 12 Then
        ' Classic Control IDs for MDB format
        idQuickPrint = 4
        idPrintDialog = 19
        idExportWord = 5535
        idExportExcel = 5534
        idClose = 1813
    Else
        ' Modern Control IDs for ACCDB format
        idQuickPrint = 2521
        idPrintDialog = 15948
        idExportWord = 11725
        idExportExcel = 11723
        idClose = 923
    End If
     
    ' Create the shortcut menu as TEMPORARY (The final parameter is set to True)
    Set cmb = CommandBars.Add(cmbName, msoBarPopup, False, True)
 
    With cmb
         
        ' Add Zoom
        Set cmbCtrl = .Controls.Add(msoControlPopup, 21, , , True)  'Zoom
            Set cmbCtrl = .Controls.Add(msoControlPopup, , , , True)
            cmbCtrl.Caption = "Zoom Report"
            cmbCtrl.Controls.Add msoControlButton, 15681, , , True   'Zoom Fit to window
            cmbCtrl.Controls.Add msoControlButton, 1834, , , True    'Zoom 10%
            cmbCtrl.Controls.Add msoControlButton, 1833, , , True    'Zoom 25%
            cmbCtrl.Controls.Add msoControlButton, 1832, , , True    'Zoom 50%
            cmbCtrl.Controls.Add msoControlButton, 1831, , , True    'Zoom 75%
            cmbCtrl.Controls.Add msoControlButton, 7, , , True       'Zoom 100%
            cmbCtrl.Controls.Add msoControlButton, 1830, , , True    'Zoom 150%
            cmbCtrl.Controls.Add msoControlButton, 1829, , , True    'Zoom 200%
            cmbCtrl.Controls.Add msoControlButton, 6463, , , True    'Zoom 500%
            cmbCtrl.Controls.Add msoControlButton, 6464, , , True    'Zoom 1000%
            
        ' Add Pages
        Set cmbCtrl = .Controls.Add(msoControlPopup, 176, , , True)  'Pages
            Set cmbCtrl = .Controls.Add(msoControlPopup, , , , True)
            cmbCtrl.Caption = "Pages View"
            cmbCtrl.Controls.Add msoControlButton, 5, , , True    '1 page
            cmbCtrl.Controls.Add msoControlButton, 639, , , True  '2 Pages
            cmbCtrl.Controls.Add msoControlButton, 1801, , , True '4 Pages
            cmbCtrl.Controls.Add msoControlButton, 1800, , , True '8 Pages
            cmbCtrl.Controls.Add msoControlButton, 1799, , , True '12 Pages
          
        ' Add the Print command.
        Set cmbCtrl = .Controls.Add(msoControlButton, idQuickPrint, , , True)
        cmbCtrl.BeginGroup = True       
        cmbCtrl.Caption = "Quick Print" 
         
        ' Add the Print command.
        Set cmbCtrl = .Controls.Add(msoControlButton, idPrintDialog, , , True)
        cmbCtrl.Caption = "Select Pages and Printer"
         
        ' Add the Page Setup... command.
        Set cmbCtrl = .Controls.Add(msoControlButton, 247, , , True)
        cmbCtrl.Caption = "Page Setup"
         
        ' Add the Mail Recipient (as Attachment)... command.
        Set cmbCtrl = .Controls.Add(msoControlButton, 2188, , , True)
        cmbCtrl.BeginGroup = True
        cmbCtrl.Caption = "Email Report as an Attachment"
         
        ' Add the PDF or XPS command (Only available if running Access 2007 or newer)
        If Val(Application.Version) >= 12 Then
            Set cmbCtrl = .Controls.Add(msoControlButton, 12499, , , True)
            cmbCtrl.Caption = "Save as PDF/XPS"
        End If

        Set cmbCtrl = .Controls.Add(msoControlButton, idExportWord, , , True)
        cmbCtrl.Caption = "Export to Word..."
        cmbCtrl.FaceId = 42

        Set cmbCtrl = .Controls.Add(msoControlButton, idExportExcel, , , True)
        cmbCtrl.Caption = "Export to Excel…"
        cmbCtrl.FaceId = 263

        ' Add the Close command.
        Set cmbCtrl = .Controls.Add(msoControlButton, idClose, , , True)
        cmbCtrl.BeginGroup = True
        cmbCtrl.Caption = "Close Report"
         
    End With
      
    Set cmb = Nothing
    Set cmbCtrl = Nothing
     
End Function

.

وعلشان تشتغل القائمة ، فيمكنك مناداتها في حدث فتح التقرير ، وتتلغيه عند المغادة ، هكذا :

Private Sub Report_Open(Cancel As Integer)

    Call SCM_Zoom_Pages_Print_Export_TEMPORARY
    Me.ShortcutMenuBar = "rpt_Zoom_Pages_Print_Export_TEMPORARY"

End Sub

Private Sub Report_Close()

    Call SCM_Zoom_Pages_Print_Export_TEMPORARY
    
End Sub