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

[dd13901390]

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

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

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

test.accdb a1.xlsx

تم تعديل السبت at 19:51 بواسطه 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

 

تم تعديل السبت at 20:32 بواسطه kanory

[Foksh]

مشاركةً مع أخي الأستاذ @kanory ، تعديل بسيط

 

Private Sub Form_Load()
    Dim obj As AccessObject, f As String, r As String
    For Each obj In CurrentProject.AllForms
        If LCase(obj.Name) <> "main" Then r = r & "نموذج:" & obj.Name & ";"
    Next
    f = Dir(CurrentProject.Path & "\*.xls*")
    Do While f <> "": r = r & "ملف:" & f & ";": f = Dir(): Loop
    Me.مربع_تحرير_وسرد1.RowSourceType = "Value List"
    Me.مربع_تحرير_وسرد1.RowSource = Left(r, Len(r) - 1)
End Sub

Private Sub مربع_تحرير_وسرد1_AfterUpdate()
    On Error GoTo ErrorHandler
    If Left(Me.مربع_تحرير_وسرد1, 6) = "نموذج:" Then
        DoCmd.OpenForm Mid(Me.مربع_تحرير_وسرد1, 7)
    Else
        With CreateObject("Excel.Application")
            .Visible = True
            .Workbooks.Open CurrentProject.Path & "\" & Mid(Me.مربع_تحرير_وسرد1, 5)
        End With
    End If
    Exit Sub
    
ErrorHandler:
    MsgBox "حدث خطأ: " & Err.Description, vbExclamation
End Sub

 

تم تعديل بالامس في 00:07 بواسطه Foksh

[dd13901390]

جزاكم الله خير ممكن تطبيقها على الامثال 

[kkhalifa1960]

مشاركةً مع الزملاء الافاضل تفضل اسناذ @dd13901390 المطلوب حسب ما فهمت بالشرح والمرفق التالي . ووافني بالرد .

                                                                                          

dd13901390.rar

[Foksh]

9 ساعات مضت, dd13901390 said:

جزاكم الله خير ممكن تطبيقها على الامثال 

تفضل ملفك بعد التطبيق

 

Lists.accdb