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

التنسيق الشرطي


MOSTAFAMM8
إذهب إلى أفضل إجابة Solved by jjafferr,

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

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

بعد اذنكم عايز ظريقة عمل تنسيق شرطي للتكرار علي شرط ان يكون التكرار في اي خانة مع ارقام متغيرة وليس  ارقام ثابتة ارقام عشوائية وليس في نفس الجدول يعني اكتب في اي خانة رقم اذا ظهر في اي خانة اخري يتمم التنسيق انا بصراحة حولت كتير بس الطريقة دي موجودة في الاكسل ولم استطيع الحصول عليها في الاكسس ارجو الافادة من الاخوة الافاضل ولكم مني جزيل الشكر و العرفان 

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

السلام عليكم 🙂

 

اهلا وسهلا بك في منتدى الاكسس 🙂

في الواقع سؤالك يجتاج الى مرفق به بيانات ، ويحتاج الى اعطائنا مثال عن النتيجة (على ملف اكسل او وورد او صورة) ، وكلما زاد الايضاح ، كلما سهلت الموضوع على الاعضاء بإيجاد اجابه لسؤالك 🙂

وإلا سيطول انتظارك 😞

 

جعفر

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

13 minutes ago, MOSTAFAMM8 said:

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

بعد اذنكم عايز ظريقة عمل تنسيق شرطي للتكرار علي شرط ان يكون التكرار في اي خانة مع ارقام متغيرة وليس  ارقام ثابتة ارقام عشوائية وليس في نفس الجدول يعني اكتب في اي خانة رقم اذا ظهر في اي خانة اخري يتمم التنسيق انا بصراحة حولت كتير بس الطريقة دي موجودة في الاكسل ولم استطيع الحصول عليها في الاكسس ارجو الافادة من الاخوة الافاضل ولكم مني جزيل الشكر و العرفان 

لو توضح لنا برسم بسيط يكون افضل

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

انا عملت على هذا النموذج فقط ، 

والكود يتعامل مع كل عمود بطريقة مستقله ، يعني انا ما عملت الكود يتعامل مع جميع حقول الجدول.

الحقول البرتقالية هي الاساس في العمل ، فهي تحتفظ بعدد كل رقم ، وبعدين تقدر تجعل هذه الحقول مخفية 🙂 

1095.Clipboard01.jpg.87e0661ed8e06de40acc77f82f657a40.jpg

.

جرب على هذا النموذج ، واذا كان مثل ما تريد ، فممكن نعدل الكود ليعمل على جميع الحقول 🙂

 

جعفر

1095.مثال.accdb.zip

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

13 hours ago, jjafferr said:

انا عملت على هذا النموذج فقط ، 

والكود يتعامل مع كل عمود بطريقة مستقله ، يعني انا ما عملت الكود يتعامل مع جميع حقول الجدول.

الحقول البرتقالية هي الاساس في العمل ، فهي تحتفظ بعدد كل رقم ، وبعدين تقدر تجعل هذه الحقول مخفية 🙂 

1095.Clipboard01.jpg.87e0661ed8e06de40acc77f82f657a40.jpg

.

جرب على هذا النموذج ، واذا كان مثل ما تريد ، فممكن نعدل الكود ليعمل على جميع الحقول 🙂

 

جعفر

1095.مثال.accdb.zip 238.95 kB · 1 download

استاذ جعفر لماذا يظهر الخطأ عن ادخال قيمة والضغط على انتر..شكرا لك استاذنا فأكوادك تحفز الدماغ

invalid use.PNG

invalid.PNG

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

  • أفضل إجابة

السلام عليكم 🙂

 

وبعد تحدي ، وصلنا للمطلوب ان شاء الله 🙂

اضفت الحقول البرتقالية لتحسب عدد المرات الموجود فيها الرقم (من او الى) ، ويمكن جعل هذا الحقل مخفي ،

الحقول الخضراء هي حقل محسوب في الجدول (موجود سابقا في البرنامج)

1095.Clipboard02.jpg.b7072b6b02730ddabed7cf47eabf0a20.jpg

.

وهذا هو التنسيق الشرطي للحقل بالسهم الاحمر:

1095.Clipboard03.jpg.bc6f355a547c06d41866f2b27ad1222c.jpg

.

هذه الوحدة النمطية التي تقوم بالعمل ،

Function Update_All()
    

    Dim mySQL As String
    Dim arr_Fields() As Variant
    Dim New_value As Long
    Dim Old_value As Long
    Dim Number_Field As String
    Dim tbl_Name As String
    Dim This_Count As Integer
    Dim Prev_Count As Integer
    Dim ctrlN As String
    Dim frmN As String
    Dim i As Integer
    Dim j As Integer
    Dim This_CountF As Integer
    Dim Prev_CountF As Integer
    
    
    frmN = Screen.ActiveForm.Name
    ctrlN = Screen.ActiveControl.Name
    
    arr_Fields = Array("من رقم الوارد", "الي رقم الوارد", "من  رقـم الرمبة", "الي  رقـم الرمبة", "من رقم التخليص", "الي رقـم النخليص")
    
    New_value = Forms(frmN)(ctrlN)
        
        If Len(Forms(frmN)(ctrlN).OldValue & "") <> 0 Then
    Old_value = Forms(frmN)(ctrlN).OldValue
        End If
    
    tbl_Name = "جدول الرصاص"
    
    
    'save Form values
    If Forms(frmN).Dirty Then Forms(frmN).Dirty = False
    
    
'1
'get the hieghst value of all fields
    For i = LBound(arr_Fields) To UBound(arr_Fields)
        ctrlN = arr_Fields(i)
        Number_Field = ctrlN & "_2"
    
        'New value
        This_CountF = DCount("*", tbl_Name, "[" & ctrlN & "]=" & New_value)
        If This_CountF > 0 Then
            This_Count = This_Count + This_CountF
        End If
        
        'Old value
        If Len(Old_value & "") <> 0 Then
            Prev_CountF = DCount("*", tbl_Name, "[" & ctrlN & "]=" & Old_value)
            If Prev_CountF > 0 Then
                Prev_Count = Prev_Count + Prev_CountF
            End If
        End If
    Next i
    
     
    'save Form values
    If Forms(frmN).Dirty Then Forms(frmN).Dirty = False
    
    
'2
'change the values in the Fields
    For i = LBound(arr_Fields) To UBound(arr_Fields)
        ctrlN = arr_Fields(i)
        Number_Field = ctrlN & "_2"
        
        'New value
        mySQL = "UPDATE [" & tbl_Name & "] SET [" & Number_Field & "] = " & This_Count
        mySQL = mySQL & " WHERE [" & ctrlN & "]=" & New_value
        'Debug.Print i & "N > " & mySQL; ""
        DoCmd.RunSQL mySQL



        'Old value
        If Len(Old_value & "") <> 0 Then
            mySQL = "UPDATE [" & tbl_Name & "] SET [" & Number_Field & "] = " & Prev_Count
            mySQL = mySQL & " WHERE [" & ctrlN & "]=" & Old_value
            'Debug.Print i & "O > " & mySQL
            DoCmd.RunSQL mySQL
        End If
    
        
        'force the field in the Form to take the new value
        Forms(frmN)(Number_Field).Requery
    
    Next i
    
End Function

.

ويتم مناداتها من حدث بعد التحديث لكل حقل ، مثلا :

Private Sub الي__رقـم_الرمبة_AfterUpdate()

    Call Update_All
End Sub

.

اسماء الحقول صارت مبرمجة في:

الجدول ، النموذج ، الوحدة النمطية ، والتنسيق الشرطي ،

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

 

جعفر

1095.مثال.accdb.zip

  • Like 1
رابط هذا التعليق
شارك

اخي الفاضل ، جوابك لا يفيدك ولا يفيدنا في حل مشكلتك !!

 

لازم تخبرنا اللي عملته ، واين صادفتك المشكلة ، وايش نوع المشكلة ، واذا في رسالة خطأ ، فنريد نعرف هذه الرسالة ، وعلى اي سطر ، ووووو

 

جعفر

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

اخي الفاضل جعفر قمت بارسال الجدول كامل حيث في الجدول المرسل يوجد به ملاحظات اخي عذرا للازعاج و اقدر المجهود و الوقت المبذل منكم و ناسف للتاخير في الرد هو فقط بسسب المحاولة 

رصاص رقم.zip

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

منذ ساعه, MOSTAFAMM8 said:

قمت بارسال الجدول كامل

رجاء اشرح المطلوب ، على اي جدول / نموذج / اسماء الحقول اللي يجب العمل عليها!!

انا وقتي اصبح جدا ضيق ، و بسافر قريبا ان شاء الله ، فرجاء اعطني المعلومات بسرعة 🙂

 

7 دقائق مضت, qassim-t said:

شكرا استاذ 

jjafferr

حياك الله اخوي قاسم 🙂

 

جعفر

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

13 ساعات مضت, MOSTAFAMM8 said:

حدول الرصاص الوارد اخي الكريم 

اولا لا يوجد عندك جدول بهذا الاسم !!

ثانيا ، حتى لو افترضنا ان قصدك "جدول الرصاص" ، فهو يحتوي على الكثير من الحقول ، فأي الحقول اللي تريد ان نطبق عليها المثال؟

image.png.e7af9d5d49d6e6142035d3ee52b3fde1.png

.

واي النماذج اللي تريد ان يكون فيها الكود؟

 

جعفر

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

من رقم الوارد الي رقم الوارد  في نموذج الرصاص الوارد حيث يتم الربط بين هذا النموذج و نموزج رصاص التخليص من رقم التخليص الي رقم التخليص و نموذج رصاص الرمبة من رقم الرمبة الي رقم الرمبة 

 

اي يتم التنسيق الشرظي عند كتابة اي رقم في هذة الحقول مع بعظها البعض

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

علشان اخلص الشغل بسرعة ، انا عملت جميع النماذج ، فاحذف اللي ما تريده 🙂

 

وفيه تعديل بسيط على الوحدة النمطية لإصطياد خطأ عدم وجود الحقل في النموذج المفتوح :

Function Update_All()
On Error GoTo err_Update_All
    

    Dim mySQL As String
    Dim arr_Fields() As Variant
    Dim New_value As Long
    Dim Old_value As Long
    Dim Number_Field As String
    Dim tbl_Name As String
    Dim This_Count As Integer
    Dim Prev_Count As Integer
    Dim ctrlN As String
    Dim frmN As String
    Dim i As Integer
    Dim j As Integer
    Dim This_CountF As Integer
    Dim Prev_CountF As Integer
    
    
    frmN = Screen.ActiveForm.Name
    ctrlN = Screen.ActiveControl.Name
    
    arr_Fields = Array("من رقم الوارد", "الي رقم الوارد", "من  رقـم الرمبة", "الي  رقـم الرمبة", "من رقم التخليص", "الي رقـم النخليص")
    
    New_value = Forms(frmN)(ctrlN)
        
        If Len(Forms(frmN)(ctrlN).OldValue & "") <> 0 Then
    Old_value = Forms(frmN)(ctrlN).OldValue
        End If
    
    tbl_Name = "جدول الرصاص"
    
    
    'save Form values
    If Forms(frmN).Dirty Then Forms(frmN).Dirty = False
    
    
'1
'get the hieghst value of all fields
    For i = LBound(arr_Fields) To UBound(arr_Fields)
        ctrlN = arr_Fields(i)
        Number_Field = ctrlN & "_2"
    
        'New value
        This_CountF = DCount("*", tbl_Name, "[" & ctrlN & "]=" & New_value)
        If This_CountF > 0 Then
            This_Count = This_Count + This_CountF
        End If
        
        'Old value
        If Len(Old_value & "") <> 0 Then
            Prev_CountF = DCount("*", tbl_Name, "[" & ctrlN & "]=" & Old_value)
            If Prev_CountF > 0 Then
                Prev_Count = Prev_Count + Prev_CountF
            End If
        End If
    Next i
    
     
    'save Form values
    If Forms(frmN).Dirty Then Forms(frmN).Dirty = False
    
    
'2
'change the values in the Fields
    For i = LBound(arr_Fields) To UBound(arr_Fields)
        ctrlN = arr_Fields(i)
        Number_Field = ctrlN & "_2"
        
        'New value
        mySQL = "UPDATE [" & tbl_Name & "] SET [" & Number_Field & "] = " & This_Count
        mySQL = mySQL & " WHERE [" & ctrlN & "]=" & New_value
        'Debug.Print i & "N > " & mySQL; ""
        DoCmd.RunSQL mySQL



        'Old value
        If Len(Old_value & "") <> 0 Then
            mySQL = "UPDATE [" & tbl_Name & "] SET [" & Number_Field & "] = " & Prev_Count
            mySQL = mySQL & " WHERE [" & ctrlN & "]=" & Old_value
            'Debug.Print i & "O > " & mySQL
            DoCmd.RunSQL mySQL
        End If
    
        
        'force the field in the Form to take the new value
        Forms(frmN)(Number_Field).Requery
    
    Next i
    
Exit_Update_All:

    Exit Function
err_Update_All:

    If Err.Number = 438 Then
        'field not in the Form
        Resume Next
        
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
        
    End If
    
End Function

جعفر

1095.رصاص رقم.accdb.zip

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information