أ / محمد صالح

لدعم اللغة العربية في ملفات الدوس أضف هذا السطر كأول سطر في النص الذي يكتب في الباتش s = s & "chcp 1256" & vbCrLf بعد الإعلان عن المتغير s dim s as String

الشكر لله حبيبي لا تنساني من دعواتك الطيبة

يمكنك استعمال هذه المعادلة في التنسيق الشرطي =COUNTIFS(A:A,A2,B:B,B2)>1 وتطبق على المدى $a$2:$a$11 وهذا ملفك به التطبيق تنسيق شرطي.xlsx

عندي يعمل بصورة ممتازة ربما بسبب أنه حينما يكون رقم الموبايل فارغا فالمتغير mob يساوي 0 وبهذا لا يتحقق الشرط فالصواب حذف الصفر المضاف قبل متغير الموبايل mob = Sheets("Find").Range("G1").Value وجعل تنسيق الخلية G1 نص text حتى يقبل الصفر في البداية وهذا ما قمت به عندي من البداية

Source = "SELECT * FROM Table2 WHERE [fdName4] BETWEEN #" & startdt & "# AND #" & stopdt & "#" & _ IIf(mob = "", "", " AND [fdName16] = '" & mob & "'") & IIf(inv = "", "", " And [fdName1] = " & inv) & ";" تم تعديل شرط إذا كان أحد الخليتين فارغا وإعادة صياغة الاستعلام

أخي الكريم @خالد القدس لقد أخبر ك الأستاذ عبد الفتاح أنه يجب وضع مسار واسم الملف في متغير باسم filename ثم استعمال الكود السابق وبناء عليه يكون الكود هكذا كاملا وهذا دورك في استنتاجه dim FileName as strring FileName = "C:\Users\kj\Desktop\WOW\2021.xlsx" ActiveWorkbook.SaveAs FileName, , , , , , xlShared ملاحظتي الشخصية: معظم الاستفسارات ناتجة من أن بعض الأصدقاء لا يصبرون على التعلم وقراءة الموضوعات السابقة والبحث في المنتدى ومحاولة فهم الأكواد والمعادلات التي يعرضها عليهم غيرهم. بالتوفيق للجميع

اقصد إحاطة القيم بعلامتين تنصيص وليس اسم الحقل Source = "SELECT * FROM Table2 WHERE [fdName4] BETWEEN #" & startdt & "# AND #" & stopdt & "#" & _ IIf(mobi = "" And invois = "", "", " AND ([fdName16] = '" & mobi & "' OR [fdName1] = " & invois & ")") & ";" لو ارفقت مثالا كان أفضل من كل هذا الشغل النظري الذي لا يفيد

عدم إعطاء اي نتائج لها احتمالات كثيرة منها: * عدم وجود نتائج فعلا في قاعدة البيانات تنطبق عليها هذه الشروط. * احتمال وجود اختلاف في نوع البيانات بين الحقول في الأكسس والخلايا في اكسل. فإذا كانت الحقول في الأكسس نصية فيجب احاطتها بعلامتين تنصيص. بالتوفيق

يمكن الاستغناء عنها في حالة عدم حدوث أخطاء محتملة وفي حالة وجود أخطاء محتملة يمكن استعمال شرط إذا كان رقم الخطأ كذا ينفذ كذا if err.number = 0 then 'your message end if مع استبدال رقم 0 برقم الخطأ

جرب هذه المعادلة في D2 =INDEX(codes!B$2:B$30, MATCH(INT(MID(B2, 8, 2)), codes!A$2:A$30,0)) بالتوفيق

لا يوجد مشكلة ضع كود الاستدعاء في حدث عند الضغط على زر الإعلاق renameMe me.fieldName مع استبدال اسم الحقل بما تريد ولعدم فتح القاعدة بعد إعادة التسمية يمكنك حذف هذا السطر من الإجراء s = s & """" & accesspath & """ """ & CurrentProject.Path & "\" & newname & "." & ext & """" & vbCrLf بالتوفيق

بعد إذن أخينا الأستاذ إبراهيم تفضل بإذن الله هذا ما تريد mas_filter_data.xlsx

رائع جدا بارك الله لك

بإذن الله الموضوع بسيط لكن أين محاولتك أنت؟ أين كود الصفحة التي تعرض هذا الجدول ؟ حتى يمكن إضافة هذه الشروط مع العلم هذا الكود يعالج ملاحظات الانتقال فقط وفير دقيق في أماكن الأعمدة

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

ربما تحتاج بعض الأكواد لتعديل لتناسب نسخة 46 بت بإضافة كلمة ptrsafe قبل كلمة function يفضل إرفاق مثال للتوضيح

جميعا بإذن الله بالتوفيق

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

جرب هذه المعادلة في I4 =IF(COUNTIFS(D:D,D4,E:E,E4)<2,H4,C4/SUMIFS(C:C,H:H,H4,D:D,D4)*H4) ومعناها إذا كان عدد تكرار حالات تساوي القراءة السابقة والحالية أقل من 2 يعني مرة واحدة تكون القيمة هي H وغير ذلك تكون كما كانت في المعادلة السابقة

تفضل هذا كود لتغيير اسم قاعدة البيانات الحالية يمكن استعماله بعد الضغط على زر مثلا Public Sub RenameMe(newname As String) Dim dbname As String, ext As String, lockext As String, accesspath As String, scriptpath As String, idx As Integer Const TIMEOUT = 30 scriptpath = Application.CurrentProject.FullName & ".dbrename.bat" accesspath = SysCmd(acSysCmdAccessDir) & "msaccess.exe" For idx = Len(CurrentProject.FullName) To 1 Step -1 If Mid(CurrentProject.FullName, idx, 1) = "." Then Exit For Next idx dbname = Left(CurrentProject.FullName, idx - 1) ext = Mid(CurrentProject.FullName, idx + 1) lockext = IIf(Left(ext, 2) = "ac", "laccdb", "ldb") Dim s As String s = s & "chcp 1256" & vbCrLf s = s & "SETLOCAL ENABLEDELAYEDEXPANSION" & vbCrLf s = s & "SET /a counter=0" & vbCrLf s = s & ":CHECKLOCKFILE" & vbCrLf s = s & "ping 0.0.0.255 -n 1 -w 100 > nul" & vbCrLf s = s & "SET /a counter+=1" & vbCrLf s = s & "IF ""!counter!""==""" & TIMEOUT & """ GOTO CLEANUP" & vbCrLf s = s & "IF EXIST """ & dbname & "." & lockext & """ GOTO CHECKLOCKFILE" & vbCrLf s = s & "ren """ & dbname & "." & ext & """ """ & newname & "." & ext & """" & vbCrLf s = s & """" & accesspath & """ """ & CurrentProject.Path & "\" & newname & "." & ext & """" & vbCrLf s = s & ":CLEANUP" & vbCrLf s = s & "del %0" Dim intFile As Integer intFile = FreeFile() Open scriptpath For Output As #intFile Print #intFile, s Close #intFile s = """" & scriptpath & """" Shell s, vbHide Application.Quit acQuitSaveAll End Sub وطريقة استدعائه RenameMe "mynewname" لاحظ أن الاسم الجديد mynewname بدون الامتداد لأنه يحافظ على نفس امتداد الملف بالتوفيق

جرب هذا الاستعلام Source = "SELECT * FROM Table2 WHERE [fdName4] BETWEEN #" & startdt & "# And #" & stopdt & "#" & IIf([A1] = "" And [A2] = "", "", " And ([fdName4] = " & [A1] & " Or [fdName16] = " & [A2] & ")") & ";"

سواء بالكود أو المعادلة يجب توضيح العلاقة بين ال 30 ماكينة حتى يفيدك أحدنا في مثالك كان هناك 3 علاقات وهي: 1 و 2 لهم نفس المعادلة و3 لها معادلة خاصة و4 و5 لهم نفس معادلة 1 و2 ولا أدري ما إذا كانت العلاقات بين ال 30 كما هي في ال 5 بنفس المتسلسلة أم لا

اعذرني حيث أن المطلوب غير واضح لي لكن حسب فهمي أنك تريد نقل البيانات في الصفوف رقم 4 و 6 و7 و8 وآخر قيمة في الصف الأخير وكلها في العمود الأول من شيت recept وكتابة ok إذا تحقق الشرط والخروج من التكرار إذا تحقق الشرط إن كان فهمي صحيحا فهذا هو التعديل: Sub recp_fill() Application.ScreenUpdating = False For a = 5 To [a10000].End(xlUp).Row If Cells(a, 2) <> "" And Cells(a, 13) = "recept1" Or Cells(a, 13) = "recept2" Or Cells(a, 13) = "recept3" Or Cells(a, 13) = "recept4" Or Cells(a, 13) = "recept5" Or Cells(a, 13) = "recept6" And Cells(a, 14) <> "ok " Then Sheets("po_rec").Cells(a, 14).Value = "ok" With Sheets("recept").[a10000].End(xlUp) .Offset(4- .row, 1) = Cells(a, 2) .Offset(6- .row, 1) = Cells(a, 5) .Offset(7- .row, 1) = Cells(a, 6) .Offset(8- .row, 1) = Cells(a, 7) .offset(0, 1) = Cells(a, 13) End With exit for End If Next a Application.ScreenUpdating = True MsgBox "!تم الترحيل بنجاح", vbInformation + vbMsgBoxRight, "تم الترحيل" Range("b6").Select End Sub بالتوفيق

العمود G والعمود I ضمن المدى الذي إذا تغير يغير المعادلات فتبقى في سلسلة لا نهاية من تنفيذ الكود وحتى تستثني العمود G والعمود I يجب أن تضيف شرط ألا يكون العمود 7 أو 9 If Target.Row > 5 And Target.Column < 11 And Target.Column <> 6 And Target.Column <> 7 And Target.Column <> 9 Then بالتوفيق

ربما لا تحتاج إلى النموذج 1 ولا التايمر الخاص به في حدث عند الفتح للنموذج الرئيس في البرنامج يمكن وضع الكود الموجود في التايمر If Day(Date) = 1 Then DoCmd.OpenForm "frmBackupCompact1" End If وبهذا سيفتح النموذج مرة واحدة عند فتح النموذج الرئيس لأن موضوع التايمر يستهلك ذاكرة الجهاز