اريد تعديل على الكود

[sm44ms]

اريد تعديل على الكود بحيث اذا اخترت من القائمة 
KH

تفتح النماذج المخصص فيها
واذا اخترت من القايمة

TW

تفتح النماذج الخصصه له طبعا بعد الضغط هلى اسم النموذج في القائمة

Private Sub KH_Click()
    ' إعادة تعيين جميع المربعات لتكون فارغة
    ClearAllLists

    ' تعبئة القوائم للنماذج المختلفة عند الضغط على KH
    Me.lstForms1.AddItem "شاشة اصدار البطاقات;FO1"
    Me.lstForms2.AddItem "شاشة تجديد البطاقات;FO2"
    Me.lstForms3.AddItem "شاشة تعديل بيانات البطاقات;FO3"
    Me.lstForms4.AddItem "شاشة تعديل بيانات اساسية فرعية;FO4"
    Me.lstForms5.AddItem "شاشة اصدار بطاقات المتقاعدين;FO5"
    Me.lstForms6.AddItem "شاشة البطاقات المنتهية;FO6"
    Me.lstForms7.AddItem "شاشة الملف الشخصي العام;FO7"

End Sub

Private Sub TW_Click()
    ' إعادة تعيين جميع المربعات لتكون فارغة
    ClearAllLists

    ' تعبئة القوائم للنماذج الخاصة بـ TW عند الضغط على TW
    Me.lstForms1.AddItem "شاشة الملف التاريخي العام;TW1"
    Me.lstForms2.AddItem "حركة الملفات التاريخية;TW2"
    Me.lstForms3.AddItem "الملف التاريخي;TW3"
    Me.lstForms4.AddItem "حالة المعاملات التاريخية;TW4"
    Me.lstForms5.AddItem "الشاشة قيد الاجراء;TW5"
    Me.lstForms6.AddItem "شاشة قيد الاجراء 2;TW6"
    Me.lstForms7.AddItem "شاشة الملف ;TW7"

End Sub

Private Sub ClearAllLists()
    ' إعادة تعيين جميع مربعات القوائم إلى الحالة الافتراضية
    Me.lstForms1.RowSource = ""
    Me.lstForms1.Value = Null
    Me.lstForms2.RowSource = ""
    Me.lstForms2.Value = Null
    Me.lstForms3.RowSource = ""
    Me.lstForms3.Value = Null
    Me.lstForms4.RowSource = ""
    Me.lstForms4.Value = Null
    Me.lstForms5.RowSource = ""
    Me.lstForms5.Value = Null
    Me.lstForms6.RowSource = ""
    Me.lstForms6.Value = Null
    Me.lstForms7.RowSource = ""
    Me.lstForms7.Value = Null
End Sub

Private Sub lstForms1_AfterUpdate()
    HandleFormOpen Me.lstForms1
End Sub

Private Sub lstForms2_AfterUpdate()
    HandleFormOpen Me.lstForms2
End Sub

Private Sub lstForms3_AfterUpdate()
    HandleFormOpen Me.lstForms3
End Sub

Private Sub lstForms4_AfterUpdate()
    HandleFormOpen Me.lstForms4
End Sub

Private Sub lstForms5_AfterUpdate()
    HandleFormOpen Me.lstForms5
End Sub
Private Sub lstForms6_AfterUpdate()
    HandleFormOpen Me.lstForms6
End Sub
Private Sub lstForms7_AfterUpdate()
    HandleFormOpen Me.lstForms7
End Sub


Private Sub HandleFormOpen(lst As Control)
    ' تحقق من العنصر المحدد في مربع القائمة
    Dim selectedIndex As Integer
    selectedIndex = lst.ListIndex

    If selectedIndex = -1 Then
        MsgBox "يرجى اختيار عنصر من القائمة.", vbExclamation
        Exit Sub
    End If

    Select Case selectedIndex
        Case 0
            ' فتح أكثر من نموذج عند Case 0
            If Not IsFormOpen("MECARD") Then DoCmd.OpenForm "MECARD"
            If Not IsFormOpen("FEND HOSTRY") Then DoCmd.OpenForm "FEND HOSTRY"
        Case 1
            If Not IsFormOpen("FORM2") Then DoCmd.OpenForm "FORM2"
            If Not IsFormOpen("FORM29") Then DoCmd.OpenForm "FORM29"
        Case 2
            If Not IsFormOpen("FORM3") Then DoCmd.OpenForm "FORM3"
        Case 3
            If Not IsFormOpen("FORM4") Then DoCmd.OpenForm "FORM4"
        Case 4
            If Not IsFormOpen("FORM5") Then DoCmd.OpenForm "FORM5"
        Case Else
            MsgBox "النموذج غير موجود."
    End Select
End Sub

Private Function IsFormOpen(formName As String) As Boolean
    ' التحقق إذا كان النموذج مفتوح بالفعل
    On Error Resume Next
    IsFormOpen = (CurrentProject.AllForms(formName).IsLoaded)
    On Error GoTo 0
End Function

Private Sub Form_Load()
    ' إعادة تعيين مربعي القوائم عند فتح النموذج
    Me.lstForms1.RowSource = "" ' تفريغ مربع القائمة الأول
    Me.lstForms2.RowSource = ""
    Me.lstForms3.RowSource = ""
    Me.lstForms4.RowSource = ""
    Me.lstForms5.RowSource = ""
    Me.lstForms6.RowSource = ""
    Me.lstForms7.RowSource = ""
End Sub

 

تم تعديل الثلاثاء at 13:47 بواسطه ابوخليل
تنسيق الكود ... نرجو الاهتمام بتنسيق الكود

[sm44ms]

ممكن

[Foksh]

15 ساعات مضت, sm44ms said:

ممكن

اخي العزيز @sm44ms ، انت ما شاء الله عضو مميز ، ولا بد لك من معرفة قوانين المنتدى بإرفاق ملف و الأهم هو العنواااان . ان يكون ذا صلة واضحة لنوع الاستفسار .

 

على العموم جرب هذه الفكرة

 

Private Sub KH_Click()
    ' إعادة تعيين جميع المربعات لتكون فارغة
    ClearAllLists

    ' تعبئة القوائم للنماذج المختلفة عند الضغط على KH
    Me.lstForms1.AddItem "شاشة اصدار البطاقات;FO1"
    Me.lstForms2.AddItem "شاشة تجديد البطاقات;FO2"
    Me.lstForms3.AddItem "شاشة تعديل بيانات البطاقات;FO3"
    Me.lstForms4.AddItem "شاشة تعديل بيانات اساسية فرعية;FO4"
    Me.lstForms5.AddItem "شاشة اصدار بطاقات المتقاعدين;FO5"
    Me.lstForms6.AddItem "شاشة البطاقات المنتهية;FO6"
    Me.lstForms7.AddItem "شاشة الملف الشخصي العام;FO7"
End Sub

Private Sub TW_Click()
    ' إعادة تعيين جميع المربعات لتكون فارغة
    ClearAllLists

    ' تعبئة القوائم للنماذج الخاصة بـ TW عند الضغط على TW
    Me.lstForms1.AddItem "شاشة الملف التاريخي العام;TW1"
    Me.lstForms2.AddItem "حركة الملفات التاريخية;TW2"
    Me.lstForms3.AddItem "الملف التاريخي;TW3"
    Me.lstForms4.AddItem "حالة المعاملات التاريخية;TW4"
    Me.lstForms5.AddItem "الشاشة قيد الاجراء;TW5"
    Me.lstForms6.AddItem "شاشة قيد الاجراء 2;TW6"
    Me.lstForms7.AddItem "شاشة الملف ;TW7"
End Sub

Private Sub ClearAllLists()
    ' إعادة تعيين جميع مربعات القوائم إلى الحالة الافتراضية
    Me.lstForms1.RowSource = ""
    Me.lstForms1.Value = Null
    Me.lstForms2.RowSource = ""
    Me.lstForms2.Value = Null
    Me.lstForms3.RowSource = ""
    Me.lstForms3.Value = Null
    Me.lstForms4.RowSource = ""
    Me.lstForms4.Value = Null
    Me.lstForms5.RowSource = ""
    Me.lstForms5.Value = Null
    Me.lstForms6.RowSource = ""
    Me.lstForms6.Value = Null
    Me.lstForms7.RowSource = ""
    Me.lstForms7.Value = Null
End Sub

Private Sub lstForms1_AfterUpdate()
    HandleFormOpen Me.lstForms1
End Sub

Private Sub lstForms2_AfterUpdate()
    HandleFormOpen Me.lstForms2
End Sub

Private Sub lstForms3_AfterUpdate()
    HandleFormOpen Me.lstForms3
End Sub

Private Sub lstForms4_AfterUpdate()
    HandleFormOpen Me.lstForms4
End Sub

Private Sub lstForms5_AfterUpdate()
    HandleFormOpen Me.lstForms5
End Sub

Private Sub lstForms6_AfterUpdate()
    HandleFormOpen Me.lstForms6
End Sub

Private Sub lstForms7_AfterUpdate()
    HandleFormOpen Me.lstForms7
End Sub

Private Sub HandleFormOpen(lst As Control)
    ' تحقق من العنصر المحدد في مربع القائمة
    Dim selectedIndex As Integer
    selectedIndex = lst.ListIndex

    If selectedIndex = -1 Then
        MsgBox "يرجى اختيار عنصر من القائمة.", vbExclamation
        Exit Sub
    End If

    ' تحديد المفتاح الخاص بكل مجموعة من النماذج
    Dim prefix As String
    If Me.KH.Visible Then
        prefix = "FO"  ' النموذج المختار من KH
    ElseIf Me.TW.Visible Then
        prefix = "TW"  ' النموذج المختار من TW
    End If

    ' فتح النموذج بناءً على الفئة المختارة
    Select Case selectedIndex
        Case 0
            OpenFormWithPrefix prefix & "1"
        Case 1
            OpenFormWithPrefix prefix & "2"
        Case 2
            OpenFormWithPrefix prefix & "3"
        Case 3
            OpenFormWithPrefix prefix & "4"
        Case 4
            OpenFormWithPrefix prefix & "5"
        Case Else
            MsgBox "النموذج غير موجود."
    End Select
End Sub

Private Sub OpenFormWithPrefix(formName As String)
    If Not IsFormOpen(formName) Then
        DoCmd.OpenForm formName
    End If
End Sub

Private Function IsFormOpen(formName As String) As Boolean
    ' التحقق إذا كان النموذج مفتوح بالفعل
    On Error Resume Next
    IsFormOpen = (CurrentProject.AllForms(formName).IsLoaded)
    On Error GoTo 0
End Function

Private Sub Form_Load()
    ' إعادة تعيين مربعي القوائم عند فتح النموذج
    Me.lstForms1.RowSource = "" ' تفريغ مربع القائمة الأول
    Me.lstForms2.RowSource = ""
    Me.lstForms3.RowSource = ""
    Me.lstForms4.RowSource = ""
    Me.lstForms5.RowSource = ""
    Me.lstForms6.RowSource = ""
    Me.lstForms7.RowSource = ""
End Sub

ما تم هو إضافة منطق لفتح النماذج بناءً على الاختيارات المختلفة ، بالإضافة إلى تخصيص الفتح حسب المجموعة المختارة .

 

[sm44ms]

اشكرك ياصديقي

لا والله حاولت ارفقه لكن حجمه كبير فاضطريت انسخ الكود على العموم اشكرك خالص الشكر

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