محمد ايمن

اخي @ابو جودي تحية طيبة 
جزاك الله كل خير ولكن التقريب يتم مع الارقام الموجبة فقط اما الارقام السالبة يتم التقريب بشكل خاطئ
تم الوصول للحل و الحمدلله و الشكر للجميع
Public Function MyRound(ByVal MainVal As Double, ByVal RoundVal As Double) As Double Dim Oldrnd As Double, X2 As Double, Newrnd As Double, Var1 As Double On Error GoTo ErrSub Var1 = RoundVal \ 2 X2 = Application.WorksheetFunction.RoundDown(MainVal / RoundVal, 0) Newrnd = X2 * RoundVal Oldrnd = MainVal - Newrnd Select Case Oldrnd Case Is >= 0 Select Case Oldrnd Case Is >= Var1 MyRound = Newrnd + RoundVal Case Is < Var1 MyRound = Newrnd End Select Case Is < 0 Var1 = Var1 * -1 Select Case Oldrnd Case Is <= Var1 MyRound = Newrnd - RoundVal Case Is > Var1 MyRound = Newrnd End Select End Select ErrSub: If Err.number <> 0 Then 'MsgBox Err.number & vbCrLf & Err.Description, vbCritical + vbMsgBoxRight MyRound = 0 Exit Function End If End Function  

تفضل اخي الكريم
Database7110.rar

اخي الكريم اذا كان المطلوب تثبيت السعر المكتوب في الخلية H1
حدد كلمة H1ضمن المعادلة و اضغط زر F4 لتصبح بهذا الشكل
G3*$H$1
ثم اسحب المعادلة للأسفل
 

تفضل اخي الكريم
New Microsoft Excel Worksheet.xlsx.rar

Me.txtAA = DateAdd("n", Me.CMPO1, Me.txtA)  

Dim xl As Excel.Application Set xl = CreateObject("Excel.Application") 'open Excel Dim wb As Excel.Workbook Dim ws As Excel.Worksheet Set wb = xl.Workbooks.Open(CurrentProject.Path & "\data22.xlsb") 'open WorkBook Set ws = wb.Worksheets("الارصدة") 'Select WorkSheet Dim data As Variant data = ws.ListObjects("الارصدة22").DataBodyRange.Rows.Count + 2 DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel12, "daybox", CurrentProject.Path & "\data22.xlsb", True, "الارصدة!A2:I" & data wb.Close xl.Quit  

تفضل اخي الكريم
ملاحظة لن تجد فرق لان الارقام في الجدول متماثلة
test117.rar

تفضل اخي الكريم
test11.rar

تفضل اخي الكريم
مع انني ضد فكرة حذف الملفات تلقائيا والسبب في بعض الاحيان تحتاج الى الرجوع لملف قديم للاطلاع على تعديل ما
ملاحظة هامة جدا :: الكود يحذف كل الملفات في المجلد D:\Backup
نسخة احتياطية مضغوطة.rar

الحمدلله تم الحل بواسطة الدالة cdate

تفضل اخي الكريم
 
db3.rar

تفضل اخي الكريم
إظهار الأرقام المفقودة2.rar

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