محمد احمد لطفى

نعم يوجد فى المنتدى تفضل

مشاركة مع أستاذى @Foksh تفضل test1.rar

تفضل من موضوع سابق بالتوفيق جلب البيانات من الرقم القمي ابو جودي.rar

جزاك الله كل خير

لم يضف تنسيق للتاريخ لقد وجدت حل DoCmd.RunSQL "SELECT Max(main1115.[datex]) AS [datex] INTO main1116 FROM main1115;" ' إضافة تنسيق لحقل التاريخ في الجدول الجديد Dim db As DAO.Database Dim prop As DAO.Property Set db = CurrentDb Set prop = db.TableDefs("main1116").Fields("[datex]").CreateProperty("Format", dbText, "yyyy/mm/dd") db.TableDefs("main1116").Fields("[datex]").Properties.Append prop مع انى قد شاهدت الامر فى سطر واحد فى احد مشاركات أستاذ AbuuAhmed تحديث DoCmd.RunSQL "SELECT Max(main1115.[datex]) AS [datex] INTO main1116 FROM main1115;" CurrentDb.TableDefs("main1116").Fields("datex").Properties.Append CurrentDb.TableDefs("main1116").CreateProperty("Format", dbText, "yyyy/mm/dd") سأترك الموضوع مفتوحا لبعض الوقت اذا كان هناك تحديث أخر

تمام عاوزين جدول main1116 حقل datex يبقى تنسيق yyyy/mm/dd برمجيا لتلافى الاخطاء او ابقاء حقل main1116 موجود دائما وعمل استعلام تحديث لاضافة اخر تاريخ من main1115

فى هذا المثال أعمل استعلام تكوين اخر تاريخ و النتيجة فى جدول جديد أريد اضافة التنسيق فى حقل التاريخ فى الجدول الجديد yyyy/mm/dd وجزاكم الله كل خير last datex.mdb

ضيف فى الكود الاول On Error Resume Next

تفضل بالتوفيق Dim db As DAO.Database Dim rst As DAO.Recordset Set db = CurrentDb Set rst = Me.RecordsetClone rst.MoveFirst Do Until rst.EOF If rst!ymd = Me.ymd Then MsgBox "تاريخ الغياب مكرر" Cancel = True Exit Do End If rst.MoveNext Loop rst.Close db.Close If rst.EOF Then MsgBox "لا يوجد سجلات" End If

يمكن ضغطه باى برنامج صغط Winrar 7-zip او رفعه على موقع mediafire

بعد اذن أستاذى @Foksh يجب شرح ما تريد بالضبط Database11 (1).accdb

تفضل بالتوفيق غير التنسيق زى ما حضرتك عاوز yyyymmdd.accdb

تفضل بالتوفيق Sub ChangeSystemDateFormat() ' تحديد التنسيق الجديد الذي تريده Dim newDateFormat As String newDateFormat = "dd/MM/yyyy" ' يمكنك تغيير هذا الجزء حسب التنسيق الذي تريده ' تشغيل أمر PowerShell لتغيير تنسيق التاريخ Dim powerShellCommand As String powerShellCommand = "powershell -Command ""Set-Culture -CultureInfo en-US; Set-WinSystemLocale -SystemLocale en-US""" Shell powerShellCommand, vbNormalFocus ' رسالة تأكيد MsgBox "تم تغيير تنسيق التاريخ على الحاسوب بنجاح!" ' اعد النظام إلى التنسيق الأصلي (اختياري) ' يمكنك استخدام نفس الأمر مع التنسيق الأصلي الذي تريده ' Dim originalDateFormat As String ' originalDateFormat = "التنسيق الأصلي" ' powerShellCommand = "powershell -Command ""Set-Culture -CultureInfo en-US; Set-WinSystemLocale -SystemLocale en-US""" ' Shell powerShellCommand, vbNormalFocus End Sub

تفضل هل هذا ما تريد 55.accdb

طب جرب Dim db As Database Set db = CurrentDb() او ارفق مثال صغير للعمل عليه بالتوفيق

استاذى @kanory بفضل الله ثم بفضل حضرتك وجدت الحل عن طريق ثلاثة استعلامات تحديث 1 - تم تحديث النشاط مباشرة بدالة FnSearch بعد أن تم تغييرها الى likeA و ليس likeB اى ما سيتم نقله هو likeA . 2 - تم مسح النشاط من حقل namex Replace([TableX].[NameX],[LikeA],"""");" 3 - تم تحديث النشاط الى LikeB اذا كان هناك شيىء خاطىء أو لم انتبه اليه يرجى اعلامى وجزاكم الله كل خير قد لمعت عيناه Replace&add Final.mdb

أستاذى @kanory ما اقصده أن نشاط للطوب الطفلى موجود بالفعل فى حقل likea وقمت ايضا بكتابته فى likeb و تم مسح للطوب الطفلى من حقل namex حاليا قمت باضافة If Nz(DLookup("LikeA", "KindX", "LikeA='" & Trim(Arr(i)) & " " & Trim(Arr(i + 1)) & " " & Trim(Arr(i + 2)) & " " & Trim(Arr(i + 3)) & " " & Trim(Arr(i + 4)) & " " & Trim(Arr(i + 5)) & " " & Trim(Arr(i + 6)) & " " & Trim(Arr(i + 7)) & "'"), 0) <> 0 Then FnSearch = DLookup("LikeB", "KindX", "LikeA='" & Trim(Arr(i)) & " " & Trim(Arr(i + 1)) & " " & Trim(Arr(i + 2)) & " " & Trim(Arr(i + 3)) & " " & Trim(Arr(i + 4)) & " " & Trim(Arr(i + 5)) & " " & Trim(Arr(i + 6)) & " " & Trim(Arr(i + 7)) & "'") Exit For ElseIf Nz(DLookup("LikeA", "KindX", "LikeA='" & Trim(Arr(i)) & " " & Trim(Arr(i + 1)) & " " & Trim(Arr(i + 2)) & " " & Trim(Arr(i + 3)) & " " & Trim(Arr(i + 4)) & " " & Trim(Arr(i + 5)) & " " & Trim(Arr(i + 6)) & "'"), 0) <> 0 Then FnSearch = DLookup("LikeB", "KindX", "LikeA='" & Trim(Arr(i)) & " " & Trim(Arr(i + 1)) & " " & Trim(Arr(i + 2)) & " " & Trim(Arr(i + 3)) & " " & Trim(Arr(i + 4)) & " " & Trim(Arr(i + 5)) & " " & Trim(Arr(i + 6)) & "'") Exit For فتم تصحيح جزء من الخطأ فى الصورة 1 ( هذه الصورة قبل اضافة الكود بالاعلى ) وتبقى جزء صغير فى الصورة 2 Replace&add.rar

عن طريق الاستعلام تفقيط الارقام فى الاكسس.accdb

تفضل بالتوفيق #If VBA7 Then Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) #Else Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) #End If Sub TestSleep() ' انتظار لمدة 1000 مللي ثانية (واحدة ثانية) Sleep 1000 End Sub

أستاذى @kanory بالفعل تم اضافة نشاط للطوب الطفلى و نقل طوب الطفلى و تم جعل حقل likea = likeb للطوب الطفلى = للطوب الطفلى و نقل بالفعل للطوب الطفلى و مسح للطوب الطفلى من الاسم و المفترض مسح الاسم (namex) likea و ليس likeb و مازلات بعض الانشطة لم يتم مسحها من namex و نقلها خطا او جزء منها حتى بعد اضافتها للمرة الثانية فى جدول الانشطة تعديل لا حظت أن الاستعلام qy_kan مخطىء بعض الانشطة لا يجلبها كاملة الصورة الثانية Replace&add.rar

أستاذى @kanory ربنا ريباركلك و يحفظك المشكلة الثانية انه بمراجعة الاستعلام qy_kan كل شيء تمام أما بخصوص الاستعلام 1 التنفيذ هناك بعض الانشطة تنقل خطأ ومرفق ملف اكسس و ملف اكسل به الانشطة الخطا حيث namex لا يمسح بعض الحروف و الكلمات kinedx لا ينقل بطريقة صحيحة او ينقل جزء من الكلام Replace&add.rar

جزاك الله كل خير استاذى @kanory جارى التجربة

لمنع ترك الحقل فارغ بالتوفيق If IsNull(Me.اسم_الحقل) Then MsgBox "يجب ملء حقل الاسم قبل الحفظ.", vbExclamation, "تحذير" Cancel = True ' إلغاء عملية التحديث End If او If Me.اسم_الحقل= "" Then MsgBox "يجب ملء حقل الاسم قبل الحفظ.", vbExclamation, "تحذير" Cancel = True ' إلغاء عملية التحديث End If

أستاذى @ابو البشر جاب عدد السجلات الصحيح و لكنى أصبح بطىء جدا