Foksh

جرب هذا التعديل أخي الكريم ، بعد تجربته عندي طبعاً أعتقد أنه مطلبك قاعده بيانات للتجارب - Copy - Copy.mdb

دي تحط تحتها 600 خط أحمر . هو مشروع جميل وفكرته حلوة بالنسبة لي ، ولكنه سيستغرق وقت وجهد طويل فعلاً ، لذا انصحك بانشاء الجداول بدايةً وباتباع اسلوب محدد وهو :- لا تستخدم أسماء عربية في مسميات الحقول . لا تستعمل المسافات بين الأسماء . لا تستعمل اسماء حقول محجوزة للبرنامج مثل ( Name,Date,To,From ..... إلخ ) لا تستعمل رموز ( #، @،$،& .... إلخ ) في مسميات الحقول . لا تستعمل الأرقام في أسماء حقول الجداول أو تبدأ بها . دي بعض الأساسيات بالنسبة لي اللي لازم أتبعها في تأسيس الجداول ، ثم اعتماد الحقل الرئيسي أو اللي لازم اربط فيه الأمور ببعضها ، وهنا هيكون رقم الكتاب المفتاح الفريد أو الغير مكرر . ابتدي وارفع ملفك ونتابع مع بعض لأنه طبعاً مستحيل يكون كل اللي انت وضحته في جلسة وحدة . بالتوفيق

نعم أخي @Zooro1 . حتى تكون الفكرة واضحة

أخي الكريم ، من يقدم المساعدة لا يعلم ما هو مقصودك بـ "مش شغال ؟؟؟؟؟؟؟؟" دون ان تطرح المشكلة ؟؟؟ وإن كان مقصدك بعدم اجراء وتنفيذ امر الطباعة !!!! فذلك لعدم وجود امر الطباعة DoCmd.PrintOut اما هذا السؤال :- فاعتقد حله كود اغلاق التقرير بعد امر الطباعة DoCmd.Close acReport, "SeparetrBySelection" مساهمة مع الأخ @Lover Karo 👍

توضحت الفكرة .. اليك حلين اثنين واختر ما تريده . الأول لو كان الإسم أكبر من 4 مقاطع :- Private Sub comb1_Click() Dim parts() As String parts = Split(txtNm.Value, " ") If UBound(parts) > 3 Then MsgBox "النص أكبر من 4 مقاطع" Exit Sub End If name1 = parts(0) name2 = parts(1) name3 = parts(2) name4 = parts(3) End Sub والثاني تحسباً لو كان الإسم أقل من 4 مقاطع :- Private Sub comb1_Click() Dim parts() As String parts = Split(txtNm.Value, " ") If UBound(parts) > 3 Then MsgBox "النص أكبر من 4 مقاطع" Exit Sub ElseIf UBound(parts) < 3 Then MsgBox "النص أصغر من 4 مقاطع" Exit Sub End If name1 = parts(0) name2 = parts(1) name3 = parts(2) name4 = parts(3) End Sub جرب واخبرني بالنتيجة 😊

للعلم اخي الكريم ، التعديل على برنامج جاهز ليلبي حاجتك قد يستغرق وقت أطول من بداية تصميمه من البداية 😅

حالياً لاني متابع من الموبايل ، اكتب لي بشرح وافي ( ولا تبخل بالشرح الواضح ) الفكرة اللي متخيلها للبرنامج من لحظة أول نموذج ..... الخ 😅

تفضل أخي الكريم Scanner DLL.accdb ارسل الكود الذي لديك لتجربته ومحاولة فهم سلوكه

الصورة من ويندوز 10 وأوفيس 2016 .

أخي @Zooro1 ، ربي يسلمك من كل مكروه لنبدأ غداً إن شاء الله في توضيح بعض النقاط والأساسيات ثم البدء بتصميم الجداول .

تفضل أخي @SAROOK ، تم التعديل على مديول المرفق وتوسيعه ليشمل كلمة "بن" أينما وردت بين مقاطع الإسم ، في الكود التالي :- Public Function qsplit(FullName As String, i As Integer) As String Dim parts() As String Dim j As Integer Dim namePart As String parts = Split(FullName, " ") For j = 0 To UBound(parts) - 1 If InStr(parts(j), "بن") > 0 Then parts(j) = parts(j) & " " & parts(j + 1) parts(j + 1) = "" End If Next j Dim count As Integer For j = 0 To UBound(parts) If parts(j) <> "" Then If count = i Then qsplit = parts(j) Exit Function End If count = count + 1 End If Next j End Function مع بقاء الإستدعاء كما هو في الملف المرفق لك ، وهذا ملفك بعد التعديل :- Splite Names.accdb

هذه الجملة كفيلة بالإجابة وهي ( لا يمكن ) لوجود علاقة بينهم .

أخي @الحياري ، جرب هذا الملف المرفق بنقله إلى أحد المسارات التالية حسب الويندوز لديك :- C:\Windows\System (Windows 95/98/Me), C:\WINNT\System32 (Windows NT/2000), or C:\Windows\System32 (Windows XP, Vista, 7, 8, 8.1, 10). twain_32.zip وأخبرني بالنتيجة إن كانت هكذا ؟

ربي يسلمك من كل مكروه أخي @ابو العزايم ،، أعتذر عن التأخير ، وبالنسبة لطلبك ، انظر لهذا التعديلات في التقرير Copy . وأخبرني بالنتيجة Ac Source.accdb

سلمك الله مهندس قاسم 🥰

تفضل أخي @Bshar ، تم الإستعانة بنموذج مؤقت Temp ، لإدراج قيم الفلترة فيه ومن ثم انشاء تقرير مبني على هذا الجدول . وهذا الكود ليقوم بتنفيذ المهمة :- Private Sub Rep_Btn_Click() ApplyFilter DoCmd.SetWarnings False DoCmd.RunSQL "DELETE FROM Temp" DoCmd.SetWarnings True Dim rs As DAO.Recordset Set rs = Me.tape5.Form.RecordsetClone If IsNull(Foksh) Then DoCmd.CancelEvent Exit Sub Else rs.MoveFirst Do Until rs.EOF Dim selectedValues() As String selectedValues = Split(Me.Foksh, ",") Dim i As Integer For i = LBound(selectedValues) To UBound(selectedValues) If InStr(1, rs!color, Trim(selectedValues(i)), vbTextCompare) > 0 Then CurrentDb.Execute "INSERT INTO Temp (ID, namee, [code-work], [t-namber], type, lincec, color) " & _ "VALUES (" & rs!ID & ", '" & Forms![add-tab]![xxf] & "', " & rs![code-work] & ", '" & rs![t-namber] & "', " & _ "'" & rs![type] & "', '" & rs![lincec] & "', '" & rs![color] & "')" Exit For End If Next i rs.MoveNext Loop rs.Close Set rs = Nothing DoCmd.OpenReport "Table1", acViewPreview End If End Sub Foksh.accdb وأعتذر عن التأخير بسبب ظرف صحي .

ضع كلمة المرور بين علامتي التنصيص ، جرب وبانتظار ردك 🤗

الملف بصيغة ACCDE ولا يمكن التعديل عليه يا صديقي

تم تعديل الكود والتأكد منه وتجربته . انسخه إلى مديول جديد ، واستدعيه بالأمر : ( CopactMyDb ) فقط حدد اسم قاعدة البيانات الخلفية التي بجانب القاعدة الرئيسية . Public Function compactDb(ByVal mydb As String, ByVal mydbb As String, ByVal mypass As String, Optional openIt As Boolean = False) Dim f As Integer Dim filenoext As String, extension As String, Access As String Access = """" & SysCmd(acSysCmdAccessDir) & "MSACCESS.EXE""" filenoext = Left(mydb, InStrRev(mydb, ".")) extension = Right(mydb, Len(mydb) - InStrRev(mydb, ".")) f = FreeFile Open CurrentProject.Path & "\compact.bat" For Output As f Print #f, "CHCP 1256" Print #f, ":checkldb1" Print #f, "if exist """ & filenoext & "l" & extension & """ goto checkldb1" Print #f, Access & " """ & mydbb & """" & mypass & " /compact" If openIt Then Print #f, ":checkldb2" Print #f, "if exist """ & filenoext & "l" & extension & """ goto checkldb2" Print #f, Access & " """ & mydb & """" Else Print #f, "del ""%~f0""" End If Close f End Function Public Function CopactMyDb() On Error Resume Next Dim Mypath, CurrDB, BEndTBL As String BEndTBL = "B-TBL.accdb" 'اسم قاعدة البيانات الخلفية CurrDB = CurrentProject.Path & "\" & CurrentProject.Name Mypath = CurrentProject.Path & "\" & BEndTBL Call compactDb(CurrDB, Mypath, "", True) Shell """" & Left(Mypath, InStrRev(Mypath, "\")) & "\compact.bat""", 0 DoCmd.Quit acQuitSaveAll End Function Desktop.zip

أخي الدكتور @الحلبي ، كما اتضحت الفكرة لدي ، اعتقد البنية للجدول قد تجعل حل الموضوع بطريقة أصعب . جرب فكرة هذا الفيديو للأستاذ هاني هنا .

ما المانع Combobox.accdb

أعتذر عن التأخير والمتابعة بسبب ظرف صحي . أخي @salah.sarea و الأخ @kamelnet5 على العموم يا صديقي بعد التركيز في مشاركتي السابقة يبدو أنني قد توجهت بشكل خاطئ للمطلوب . القاعدة المقسمة والمرتبطة بقاعدة بيانات الواجهة الرئيسية ( الأمامية ) لا بد من أنها ترتبط مع الجداول دون أن تقوم بإدخال الباسوورد بشكل يدوي كل مرة هل هذا صحيح ؟؟ وعليه وإن كان / أو لم يكن هناك كلمة مرور لقاعدة بيانات الجداول جرب هذا المرفق يعمل معي بكفاءة . وهذا كود الدالة :- Public Function compactDb(ByVal mydb As String, ByVal mypass As String, Optional openIt As Boolean = False) Dim f As Integer Dim filenoext As String, extension As String, Access As String Access = """" & SysCmd(acSysCmdAccessDir) & "MSACCESS.EXE""" filenoext = Left(mydb, InStrRev(mydb, ".")) extension = Right(mydb, Len(mydb) - InStrRev(mydb, ".")) f = FreeFile Open CurrentProject.Path & "\compact.bat" For Output As f Print #f, "CHCP 1256" Print #f, ":checkldb1" Print #f, "if exist """ & filenoext & "l" & extension & """ goto checkldb1" Print #f, Access & " """ & mydb & """" & mypass & " /compact" If openIt Then Print #f, ":checkldb2" Print #f, "if exist """ & filenoext & "l" & extension & """ goto checkldb2" Print #f, Access & " """ & mydb & """" Else Print #f, "del ""%~f0""" End If Close f End Function Public Function CopactMyDb() On Error Resume Next Dim Mypath As String Mypath = CurrentProject.Path & "\" & CurrentProject.Name Call compactDb(Mypath, "", True) Shell """" & Left(Mypath, InStrRev(Mypath, "\")) & "\compact.bat""", 0 DoCmd.Quit acQuitSaveAll End Function ويتم الإستدعاء في أي زر = CopactMyDb Compact.accdb

اعتذر عن التأخير في المتابعة بسبب ظرف صحية

اعتذر عن التأخير في المتابعة بسبب ظرف صحة

اعتذر عن التأخير في المتابعة بسبب ظرف صحة