منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب

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

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

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

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

وشكرا للجميع

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

السلام عليكم ..
اخى الحبيب امير
خالص الشكر لتجاوبك ..
للاسف صديقى ان الكود لم ياتى باى نتائج
اليك بعض الاكواد المستخدمة ولم تاتى بنتائج
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

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

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