اذهب الي المحتوي
أوفيسنا

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

jo_2010

بواسطه jo_2010
في قسم الأكسيس Access

 مشاركة
إذهب إلى أفضل إجابة Solved by Foksh,

الردود الموصى بها

jo_2010

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

رابط هذا التعليق
شارك
kkhalifa1960

kkhalifa1960

قام بنشر
قام بنشر (معدل)

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

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

 

تم تعديل بواسطه kkhalifa1960
رابط هذا التعليق
شارك
jo_2010

jo_2010

قام بنشر
  • الكاتب
قام بنشر
3 ساعات مضت, kkhalifa1960 said:

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

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. علامة صفراء

رابط هذا التعليق
شارك
محمد احمد لطفى

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

قام بنشر
قام بنشر (معدل)

أستاذ @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

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

تم تعديل بواسطه محمد احمد لطفى
  • Thanks 1
رابط هذا التعليق
شارك
Foksh

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

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

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

Untitled.png

LAB_2024.rar

رابط هذا التعليق
شارك
  • ابوخليل changed the title to تحويل كود الى وحدة نمطية
abouelhassan

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

Foksh

قام بنشر
  • أفضل إجابة
قام بنشر
9 ساعات مضت, jo_2010 said:

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

Untitled.png

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

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  ~|

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

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

تم تعديل بواسطه jo_2010
  • Thanks 1
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
 مشاركة
الذهاب الي قائمه المواضيع

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept