Shivan Rekany

استاذي الحبيب هل من الممكن عند كتابة ايميل خطأ ان يعطينا الرسالة ان هذا الايميل خطا لا تقدر ان ترسل له الرسالة اي اذا كان ذاك الايميل ليس لها وجود تقبل تحياتي

اتفضل اليك تكملة الكود نتيجة_عربي: IIf([Kind_edu]="نظامي" And Val([Ar_2])<12 Or [Kind_edu]="نظامي" And [عربي]<50;"عربي";IIf([Kind_edu]="منازل" And Val([عربي22])<30 Or [Kind_edu]="منازل" And [عربي]<50;"عربي";IIf([Kind_edu]="تعليم مجتمعي" And Val([Ar_2])<12.5 Or [Kind_edu]="تعليم مجتمعي" And [عربي]<50;"عربي";" "))) وهذا هو المرفق نتيجة عربي (1).rar

اليك هذا نتيجة_عربي: IIf([Kind_edu]="نظامي" And Val([Ar_2])<12 Or [Kind_edu]="نظامي" And [عربي]<50;"عربي";" ") قاعدتك فيها اكثر من 7000 سجلات لعمل التعديلات ولرفع المنتدى خلي قلل سجلات الى 10 حتى 20 سجلات لكي يسهل على الجماعة هل تريد ان نضيف للكود للمنازل والمجتمعي ام الكود الاعلاه يكفي ؟

مشاركة مع استاذي الحبيب @ابوخليل والسبب الثاني ما يشتغل عندك مفاتيح مختصرة وهو ان الخاصية كي بريفيو للنموذج هو لا "نو" غيرها الى نعم "يس" او عند فتح النموذج اكتب me.keypreview = yes لكي يشتغل المفاتيح المختصرة

السلام عليكم السبب يرجع لانك استخدمت "&" بدل ";" اتفضل اليك ماتريد عربي22: IIf([Kind_edu]="نظامي";Val([N_Ar_2])+Val([Ar_2]);IIf([Kind_edu]="منازل";Val([Ar_2])*2.5;IIf([Kind_edu]="تعليم مجتمعي";Val([Ar_2])))) و عربي: IIf([Kind_edu]="نظامي" Or [Kind_edu]="منازل";Val(Val([عربي11])+Val([عربي22]))/2;IIf([Kind_edu]="تعليم مجتمعي";Val([عربي11])+Val([عربي22]))) و نتيجة عربي.rar

استأذن من استاذنا @ابوخليل و @رمهان لا اعرف هذه الاكواد من صتع اي من اخواننا اولا سيعمل لك فولدر باسم باك اب في قرص دي وايضا يعمل باك اب للجداول والعلاقات اتفضل اليك الصق هذا في وحدة نمطية Option Compare Database Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long Public Function ExportNew(myfile As String) ' إنشاء ملف جديد Dim wrkDefault As Workspace Dim dbsNew As Database Dim mydb On Error GoTo gv mydb = Dir(myfile) If mydb = "" Then Set wrkDefault = DBEngine.Workspaces(0) Set dbsNew = wrkDefault.CreateDatabase(myfile, dbLangArabic) Call exportTbl(myfile) GoTo gv1 Else Call exportTbl(myfile) GoTo gv1 End If gv: Resume gv1: End Function Public Function exportTbl(myfile As String) 'تصدير نسخة لجميع الجداول الموجودة' Dim tdfCurr As TableDef Dim strBackupDatabase As String strBackupDatabase = myfile For Each tdfCurr In CurrentDb().TableDefs If (tdfCurr.Attributes And dbSystemObject) = 0 Then DoCmd.TransferDatabase acExport, "Microsoft Access", _ strBackupDatabase, acTable, tdfCurr.Name, _ tdfCurr.Name End If Next tdfCurr End Function Function ExportRelations(DbName, DbName2 As String) As Integer 'الحاق العلاقات بالجداول المنسوخة Dim ThisDb As dao.Database, ThatDB As dao.Database Dim ThisRel As dao.Relation, ThatRel As dao.Relation Dim ThisField As dao.Field, ThatField As dao.Field Dim Cr As String, i As Integer, cnt As Integer, RCount As Integer Dim j As Integer Dim ErrBadField As Integer Cr$ = Chr$(13) RCount = 0 Set ThisDb = DBEngine.Workspaces(0).OpenDatabase(DbName2) Set ThatDB = DBEngine.Workspaces(0).OpenDatabase(DbName) For i = 0 To ThatDB.Relations.Count - 1 Set ThatRel = ThatDB.Relations(i) Set ThisRel = ThisDb.CreateRelation(ThatRel.Name, _ ThatRel.Table, ThatRel.ForeignTable, ThatRel.Attributes) ErrBadField = False For j = 0 To ThatRel.Fields.Count - 1 Set ThatField = ThatRel.Fields(j) Set ThisField = ThisRel.CreateField(ThatField.Name) ThisField.ForeignName = ThatField.ForeignName On Error Resume Next ThisRel.Fields.Append ThisField If Err <> False Then ErrBadField = True On Error GoTo 0 Next j If ErrBadField = True Then Else On Error Resume Next ThisDb.Relations.Append ThisRel If Err <> False Then Else RCount = RCount + 1 End If On Error GoTo 0 End If Next i ThisDb.Close ThatDB.Close ExportRelations = RCount End Function Public Sub autobackup() Dim datefile As Date Dim timefile As Date Dim pro As String datefile = Date timefile = Time pro = Mid(CurrentProject.Name, 1, (Len(CurrentProject.Name) - 4)) & " " & _ Format(datefile, "yyyy-mm-dd") & " " & Format(timefile, "hh-nn-ss") Path = "D:\Backup\" x = Path Select Case x End Select MakeSureDirectoryPathExists Path & "\" Call ExportNew(x & "\" & pro & ".dat") Call ExportRelations(CurrentProject.FullName, x & "\" & pro & ".dat") MsgBox "تم انشاء نسخة احتياطية بشكل آلي بنجاح في المسار" & vbCrLf & "D:\Backup\", vbInformation End Sub وفي نموذج خلف زر اكتب هذا Call autobackup

اليك هذا الرابط به ما تريد

فقط فكر انت في المنتدى بها عمالقة اكسس مثل استاذنا ابوخليل و جعفر و رمهان و ابوابراهيم الغامدي و محمد ايمن و صالح حمادي و السيد جمال و ..... الخ واليك هذا الرابط بها ما تريد لاحد العمالقة

اهلا بك اخي @Ahmed.IQ اتفضل اليك هذا If DCount("*", "MsysObjects", "[Name]='table1'") > 0 Then MsgBox "الجدول موجود" Else MsgBox "الجدول غير موجود" End If غير table1 باسم جدولك تقبل تحياتي

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

حجم المرفق وعدده لها دور في ذلك؟ شكرا لك

انا كان اول شخص عند تحميل المرفق لكن للاسف ما كان عندي وقت كافي للعمل التجربة وقبل الان انها عملت التجربة لكن بطريقة سي دي او و اخترت مرفقين والنتيجة 100 % لكن شوية بطيئة امر الارسال و فتح النموذج مع تقدير

شكرا لك @أ / محمد صالح على الشرح الوافي الكافي

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

هل عند فتح برامج اكسس جديد بيعطيك هذه الرسالة ؟ اذا لا تأمكد من مكتبات المطلوبة

رامبو ....... اخيرا الحمد لله صاحب السؤال وصلت الى النتيجة

راح تستخدم الكود هكذا عند الضعط على زر ExitWindowsEx EWX_LOGOFF, 0

استغفر الله اخي @ابا جودى هذه المنتدى للتعليم لذا اكتب لنا ما عندك كلنا راح نستفيد منك تقبل تحياتي

تم تغير الكود اولا سنعرف على عدد سجلاتنا في الجدول وبعد العملية الاستيراد راح نعدد سجلاتنا من جديد والفرق بينهما هو عدد استيراد السجلات Dim dcou As Integer Dim dcou1 As Integer dcou = DCount("*", "table") DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Tablex", m_strFileName, True DoCmd.SetWarnings False DoCmd.OpenQuery "import_tbl" DoCmd.DeleteObject acTable, "Tablex" DoCmd.SetWarnings True dcou1 = DCount("*", "table") txtImportFile = "" MsgBox ("تم استيراد ( " & dcou - dcou1 & " ) سجلات") اليك قاعدة بياناتك بعد تعديل الطلبية الاستيراد مكررة او غير مكررة هذا يعود لك ونحن لا نقدر ان نغير فيه لان هذه المشاركة مختصة ب رسالة عدد السجلات التى ستم استيرادها واليك ملفك بعد التعديل Access -Import.rar

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

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

لان عملية استراد بيحذف الجدول وبيضاف من جديد استخدم هذا الكود بدل الكودك السابق عند الضغط على الزر Dim dcou As Integer DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Tablex", m_strFileName, True DoCmd.SetWarnings False DoCmd.OpenQuery "import_tbl" DoCmd.DeleteObject acTable, "Tablex" DoCmd.SetWarnings True txtImportFile = "" dcou = DCount("*", "Table") MsgBox ("تم استيراد ( " & dcou & " ) سجلات بنجاح") واليك ملفك بعد تعديل Access -Import.rar

بعد اقول غريبة لماذا استخدم المبرمج هذه الاسماء ما رأيت بحياتي واحد بيسمى الحقول والجداول بهذه الاسماء هل في المستقبل سيعرف ما عمله ؟ هذا هو السر اللي افكر فيه ...

اولا انا اشكركم لانكم قبلت ان اكون معكم مع العملية : الى الاعلى int(1988.98) = 1988 int(1988.98) / 10 = 198.8 1 + Int(1988.98) / 10 = 199.8 Int(1 + Int(T3) / 10) = 199 Int(1 + Int(T3) / 10) * 10 = 1990 ونقدر ان نستخدم دالة Fix

اذنك معك استاذي الحبيب وهذا هو تعديل ما قلت استاذنا على القاعدة Hawadith3.rar