تحويل كود الى وحدة نمطية

[jo_2010]

الخبراء الافاضل 

اريد تحويل كود زر الى وحدة نمطية

Me.P_Day.SourceObject = "NewPU"
Me.P_Day.Form.TN.Caption = "Urine"
Dim myfilter As String
myfilter = "[TName]='" & "Urine" & "'"
Me.P_Day.Form.Filter = myfilter
Me.P_Day.Form.FilterOn = True

Me.JO = 3
Me.U_OK.Requery
 

مع العلم ان الزر موجود فى نموذج رئيسى اسمة newpara

P_Day نموذج فرعى

U_OK   نموذج فرعى

jo مربع نص فى النموذج الرئيسى newpara

[Foksh]

أرفق مثالك يا صديقي 

[kkhalifa1960]

تفضل أخي محاولتي .

Private Sub Jo_2010()
Me.P_Day.SourceObject = "NewPU"
Me.P_Day.Form.TN.Caption = "Urine"
Dim myfilter As String
myfilter = "[TName]='" & "Urine" & "'"
Me.P_Day.Form.Filter = myfilter
Me.P_Day.Form.FilterOn = True
Me.Jo = 3
Me.U_OK.Requery
End Sub

Private Sub Command0_Click()
Jo_2010
End Sub

 

تم تعديل مايو 10 بواسطه kkhalifa1960

[jo_2010]

3 ساعات مضت, kkhalifa1960 said:

تفضل أخي محاولتي .

Private Sub Jo_2010()
Me.P_Day.SourceObject = "NewPU"
Me.P_Day.Form.TN.Caption = "Urine"
Dim myfilter As String
myfilter = "[TName]='" & "Urine" & "'"
Me.P_Day.Form.Filter = myfilter
Me.P_Day.Form.FilterOn = True
Me.Jo = 3
Me.U_OK.Requery
End Sub

Private Sub Command0_Click()
Jo_2010
End Sub

 

استاذى الفاضل اريد وحدة نمطية puplic لانى عند وضعها فى وحدة نمطيةخارج النموذج بيسالنى me. علامة صفراء

[Foksh]

أعتقد أنه في الوحدة النمطية لا يمكن استخدام التصريح Me إشارة الى عنصر ما داخل النموذج !!

[محمد احمد لطفى]

أستاذ @jo_2010
 

Public Function Jo_2010 ()
    Forms("YourFormName").Controls("P_Day").SourceObject = "NewPU"
    Forms("YourFormName").Controls("P_Day").Form.Controls("TN").Caption = "Urine"
    Dim myfilter As String
    myfilter = "[TName]='" & "Urine" & "'"
    Forms("YourFormName").Controls("P_Day").Form.Filter = myfilter
    Forms("YourFormName").Controls("P_Day").Form.FilterOn = True
    
    Forms("YourFormName").Controls("JO") = 3
    Forms("YourFormName").Controls("U_OK").Requery
End Function

قم بتغيير  YourFormName باسم النموذج المراد العمل عليه 

أو 

 

Public Function Jo_2010 ()
    Dim frm As Form
    Set frm = Screen.ActiveForm ' النموذج الحالي
    
    If Not frm Is Nothing Then
        frm.Controls("P_Day").SourceObject = "NewPU"
        frm.Controls("P_Day").Form.Controls("TN").Caption = "Urine"
        Dim myfilter As String
        myfilter = "[TName]='" & "Urine" & "'"
        frm.Controls("P_Day").Form.Filter = myfilter
        frm.Controls("P_Day").Form.FilterOn = True
        
        frm.Controls("JO") = 3
        frm.Controls("U_OK").Requery
    Else
        MsgBox "No active form found.", vbExclamation
    End If
End Function

مفترض أن يعلم النموذج الذى سيتم العمل علية
 
لم أقوم بالتجريب لانه لا يوجد مرفق 
                                                                           

تم تعديل مايو 10 بواسطه محمد احمد لطفى

[Foksh]

ومساهمة مع الأساتذة جزاهم الله خير ،

حسب ما فهمت من الكود 😅 .

كود المديول :-

Public Function ApplyFilterToSubForm(subForm As Form, filterText As String)
    subForm.Form.Filter = filterText
    subForm.Form.FilterOn = True
End Function

وللإستدعاء من النموذج في حدث عند النقر :-

ApplyFilterToSubForm Forms("P_Day"), "[TName]='Urine'"
U_Ok.Requery

هي الفكرة انك تطبق الفلترة على النموذج الفرعي P_Day من مربع النص TName اللي بتساوي Urine .

 

جرب وأعطيني النتيجة ، أو أرسل مرفقك للتطبيق ، فليست النتيجة واضحة دون مرفق أخي @jo_2010

[jo_2010]

8 ساعات مضت, Foksh said:

ومساهمة مع الأساتذة جزاهم الله خير ،

حسب ما فهمت من الكود 😅 .

كود المديول :-

Public Function ApplyFilterToSubForm(subForm As Form, filterText As String)
    subForm.Form.Filter = filterText
    subForm.Form.FilterOn = True
End Function

وللإستدعاء من النموذج في حدث عند النقر :-

ApplyFilterToSubForm Forms("P_Day"), "[TName]='Urine'"
U_Ok.Requery

هي الفكرة انك تطبق الفلترة على النموذج الفرعي P_Day من مربع النص TName اللي بتساوي Urine .

 

جرب وأعطيني النتيجة ، أو أرسل مرفقك للتطبيق ، فليست النتيجة واضحة دون مرفق أخي @jo_2010

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

LAB_2024.rar

[abouelhassan]

محاولة

Sub UpdateP_DayForm()
    Forms!newpara!P_Day.SourceObject = "NewPU"
    Forms!newpara!P_Day.Form.TN.Caption = "Urine"
    Dim myfilter As String
    myfilter = "[TName]='" & "Urine" & "'"
    Forms!newpara!P_Day.Form.Filter = myfilter
    Forms!newpara!P_Day.Form.FilterOn = True
    
    Forms!newpara!JO = 3
    Forms!newpara!U_OK.Requery
End Sub

 

[Foksh]

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

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

LAB_2024.rar 1.84 \u0645\u064a\u062c\u0627 \u0628\u0627\u064a\u062a · 1 download

استناداً إلى ما طلبت ، هذا المديول العام الذي خرجت به :-

Public Sub ApplyFilterToSubForm(subFormName As String, filterCriteria As String, captionText As String, JOValue As Integer)
    On Error Resume Next
    Dim subForm As Form
    Forms("NewPara").P_Day.sourceObject = "NewPU"
    Set subForm = Forms("NewPara").Controls(subFormName).Form
    If Not subForm Is Nothing Then
        subForm.TN.caption = captionText
        subForm.Form.Filter = filterCriteria
        subForm.Form.FilterOn = True
        Forms("NewPara").JO = JOValue
        Forms("NewPara").U_OK.Requery
        subForm.SetFocus
        Forms("NewPara").SNormal.SetFocus
    Else
        MsgBox "Subform '" & subFormName & "' not found.", vbExclamation
    End If
End Sub

وهنا الإستدعاء له في الأزرار الـ 5 في القائمة المنسدلة الخاصة بك :-

Public Sub Urine()
    ApplyFilterToSubForm "P_Day", "[TName]='Urine'", "Urine", 3
    Forms("NewPara").Controls("Name_Urine").caption = "All"
End Sub

Public Sub Stool()
    ApplyFilterToSubForm "P_Day", "[TName]='Stool'", "Stool", 4
End Sub

Public Sub Lipids()
    ApplyFilterToSubForm "P_Day", "[TName]='Lipids'", "Lipids", 15
End Sub

Public Sub Creat()
    ApplyFilterToSubForm "P_Day", "[TName]='Creatinine'", "Creat", 9
End Sub

Public Sub All()
    Forms("NewPara").P_Day.sourceObject = "NewPp"
    Forms("NewPara").U_OK.Requery
    Forms("NewPara").Controls("Name_Urine").caption = "Urine"
End Sub

 

وهذا المرفق بعد التطبيق |~  LAB_2024 - JO.zip  ~|

جرب وأخبرني بالنتيجة 😊

[jo_2010]

3 ساعات مضت, Foksh said:

استناداً إلى ما طلبت ، هذا المديول العام الذي خرجت به :-

Public Sub ApplyFilterToSubForm(subFormName As String, filterCriteria As String, captionText As String, JOValue As Integer)
    On Error Resume Next
    Dim subForm As Form
    Forms("NewPara").P_Day.sourceObject = "NewPU"
    Set subForm = Forms("NewPara").Controls(subFormName).Form
    If Not subForm Is Nothing Then
        subForm.TN.caption = captionText
        subForm.Form.Filter = filterCriteria
        subForm.Form.FilterOn = True
        Forms("NewPara").JO = JOValue
        Forms("NewPara").U_OK.Requery
        subForm.SetFocus
        Forms("NewPara").SNormal.SetFocus
    Else
        MsgBox "Subform '" & subFormName & "' not found.", vbExclamation
    End If
End Sub

وهنا الإستدعاء له في الأزرار الـ 5 في القائمة المنسدلة الخاصة بك :-

Public Sub Urine()
    ApplyFilterToSubForm "P_Day", "[TName]='Urine'", "Urine", 3
    Forms("NewPara").Controls("Name_Urine").caption = "All"
End Sub

Public Sub Stool()
    ApplyFilterToSubForm "P_Day", "[TName]='Stool'", "Stool", 4
End Sub

Public Sub Lipids()
    ApplyFilterToSubForm "P_Day", "[TName]='Lipids'", "Lipids", 15
End Sub

Public Sub Creat()
    ApplyFilterToSubForm "P_Day", "[TName]='Creatinine'", "Creat", 9
End Sub

Public Sub All()
    Forms("NewPara").P_Day.sourceObject = "NewPp"
    Forms("NewPara").U_OK.Requery
    Forms("NewPara").Controls("Name_Urine").caption = "Urine"
End Sub

 

وهذا المرفق بعد التطبيق |~  LAB_2024 - JO.zip  ~|

جرب وأخبرني بالنتيجة 😊

معلمى الخبير الفاضل  المبدع احسنت لك خالص الشكر 

تم تعديل مايو 11 بواسطه jo_2010