القائمة المنسدلة للنموذج

[dd13901390]

السلام عليكم ورحمة الله وبركاتة اخواني الاعزاء الرجاء منكم المساعدة في حل هذا البرنامج 

وهو عبارة عن فتح النماذج عن طريق القائمة المنسدلة واريد كذلك فتح الملف المرفق بالاكسل يكون من ضمن القائمة باسم (a1 ) طبعا كلهم في الاكسس والمطلوب موجود في البرنامج 

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

test.accdb a1.xlsx

تم تعديل منذ 3 ساعات بواسطه dd13901390

[kanory]

منذ ساعه, dd13901390 said:

وهو عبارة عن فتح النماذج عن طريق القائمة المنسدلة واريد كذلك فتح الملف المرفق بالاكسل يكون من ضمن القائمة باسم (a1 ) طبعا كلهم في الاكسس والمطلوب موجود في البرنامج 

طلبك غريب شوي ,,,,,, لكن استخدم هذه الاكواد ...............................

Private Sub Form_Load()
    Dim db As DAO.Database
    Dim obj As AccessObject
    Dim strPath As String
    Dim strFile As String
    Dim RowSource As String


    ' إضافة النماذج الموجودة (مع استثناء نموذج "main")
    Set db = CurrentDb
    For Each obj In CurrentProject.AllForms
        If LCase(obj.Name) <> "main" Then
            RowSource = RowSource & "نموذج:" & obj.Name & ";"
        End If
    Next obj

    ' البحث عن ملفات إكسل في نفس مسار قاعدة البيانات
    strPath = CurrentProject.Path & "\"
    strFile = Dir(strPath & "*.xlsx*") ' يشمل xls و xlsx

    Do While strFile <> ""
        RowSource = RowSource & "ملف:" & strFile & ";"
        strFile = Dir
    Loop

    ' تحديث مصدر الصفوف لمربع التحرير والسرد
    If Right(RowSource, 1) = ";" Then
        RowSource = Left(RowSource, Len(RowSource) - 1)
    End If

    Me.مربع_تحرير_وسرد1.RowSourceType = "Value List"
    Me.مربع_تحرير_وسرد1.RowSource = RowSource
End Sub

Private Sub مربع_تحرير_وسرد1_AfterUpdate()
    Dim selectedItem As String
    selectedItem = Me.مربع_تحرير_وسرد1.Value

    If Left(selectedItem, 6) = "نموذج:" Then
        DoCmd.OpenForm Mid(selectedItem, 7)

    ElseIf Left(selectedItem, 4) = "ملف:" Then
        Dim filePath As String
        filePath = CurrentProject.Path & "\" & Mid(selectedItem, 5)

        Dim xlApp As Object
        On Error Resume Next
        Set xlApp = CreateObject("Excel.Application")
        On Error GoTo 0

        If Not xlApp Is Nothing Then
            xlApp.Visible = True
            xlApp.Workbooks.Open filePath
        Else
            MsgBox "تعذر تشغيل Microsoft Excel.", vbExclamation
        End If
    End If
End Sub

 

تم تعديل منذ 2 ساعات بواسطه kanory