[sabmov]

السلام عليكم  .. 
بعد عودة طويلة اتشرف بالعودة للمنتدى 
اتمنى من الزملاء ايجاد حل لاجراء عملية حسابية .
لدى حقل باسم width 
المطلوب  فى حدث after update لهذا الحقل .. 

الحالة 1 ..عند كتابة رقم صحيح + كسر  
اذا كان الكسر اقل من 0.5 ان يتم حذف الكسر ويبقى الرقم الصحيح ( مثال 1.4بعد التحديث تصبح القيمة 1)

حالة 2 ..عند كتابة رقم صحيح + كسر  
اذا كان الكسر = 0.5 ان يتم يترك الرقم الصحيح +الكسر ( مثال 2.5بعد التحديث تصبح القيمة 2.5)

حالة 3 ..عند كتابة رقم صحيح + كسر  
اذا كان الكسر اكبر من 0.5 ان يتم جبر بحيث يجبر الرقم الصحيح للقيمة الاعلى  ا( مثال 4.6 بعد التحديث تصبح القيمة 5)

وشكرا للجميع

[sabmov]

يرجى من خبراء الاكسيس التكرم بحل المسألة
شكرا للجميع

[sabmov]

السلام عليكم ..
اخى الحبيب امير
خالص الشكر لتجاوبك ..
للاسف صديقى ان الكود لم ياتى باى نتائج
اليك بعض الاكواد المستخدمة ولم تاتى بنتائج
Private Sub width_AfterUpdate()
Dim integerPart As Long
Dim fractionalPart As Double
Dim originalValue As Double

' حفظ القيمة الأصلية المدخلة قبل أي تعديل
originalValue = Me.width
' استخراج الجزء الصحيح من القيمة المدخلة (مثال: من 5.4 سيكون الناتج 5)
integerPart = Int(originalValue)
' استخراج الجزء الكسري فقط مع تقريبه لمنزلتين عشريتين (مثال: 5.4 - 5 = 0.4)
fractionalPart = Round(originalValue - integerPart, 2)

' البدء في فحص قيمة الكسر
If fractionalPart < 0.5 Then
' إذا كان الكسر أقل من 0.5 (مثل 5.4)، يتم إعادة القيمة إلى الجزء الصحيح فقط (5)
Me.width = integerPart
ElseIf fractionalPart = 0.5 Then
' إذا كان الكسر يساوي 0.5 (مثل 4.5)، يتم ترك القيمة كما هي (4.5)
Me.width = originalValue
ElseIf fractionalPart > 0.5 Then
' إذا كان الكسر أكبر من 0.5 (مثل 7.6)، يتم إضافة 1 إلى الجزء الصحيح (7+1=8)
Me.width = integerPart + 1
End If
End Sub

كود اخر
Private Sub width_AfterUpdate()
Dim integerPart As Long
Dim fractionalPart As Double

' استخراج الجزء الصحيح من القيمة المدخلة
integerPart = Int(Me.width)
' استخراج الجزء الكسري وتقريبه لمنزلتين عشريتين
fractionalPart = Round(Me.width - integerPart, 2)

' البدء في فحص قيمة الكسر
Select Case fractionalPart
' إذا كان الكسر أقل من 0.5
Case Is < 0.5
' يتم إعادة القيمة إلى الجزء الصحيح فقط
Me.width = integerPart
' إذا كان الكسر أكبر من 0.5
Case Is > 0.5
' يتم إضافة 1 إلى الجزء الصحيح
Me.width = integerPart + 1
' إذا كان الكسر يساوي 0.5
Case 0.5
' يتم ترك القيمة كما هي
Me.width = Me.width
End Select
End Sub


كود اخر
Private Sub width_AfterUpdate()
Dim originalValue As Double
Dim decimalPart As Long

' حفظ القيمة الأصلية المدخلة
originalValue = Me.width

' استخراج الكسر وضربه في 10، ثم تقريبه لأقرب عدد صحيح
' مثال: (5.4 - 5) * 10 = 4.0 -> CLng(4.0) = 4
' مثال: (7.6 - 7) * 10 = 6.0 -> CLng(6.0) = 6
' مثال: (4.5 - 4) * 10 = 5.0 -> CLng(5.0) = 5
decimalPart = CLng(Round((originalValue - Int(originalValue)) * 10, 0))

' البدء في فحص الكسر المحول
Select Case decimalPart
' إذا كان الكسر أقل من 5
Case Is < 5
Me.width = Int(originalValue)
' إذا كان الكسر أكبر من 5
Case Is > 5
Me.width = Int(originalValue) + 1
' إذا كان الكسر يساوي 5
Case 5
Me.width = originalValue
End Select
End Sub

[sabmov]

بداية اكرر شكرى ..
كنت اتمنى ان ابشرك بنجاح الكود .. ولكن ..
عموما .. خالص تحياتى . وجزاك الله عنى كل الخير

[mbc321]

ممكن ترفق الملف وبإذن الله الحل بيسط