Foksh

طيب اسمح لي بسؤال غريب شوية .. المستخدم للبرنامج هيستفيد ايه ؟؟؟؟؟ المفروض الجداول تكون غير ظاهرة ليك كمستخدم !!!!!🙄 إنت بس وصلني للهدف واتركها على الله

أعانكم الله على ما بدأتم ،، ونسأل الله التوفيق لنا ولكم ، ومتابع معك إن شاء الله بتكاتف الجهود طبعاً

فسرها لي دي .. ابراهيم وسام اريج إزاي !!!!!!!!!!! أبجدياً يفترض يكون وسام آخر طالب !!!

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

وعليكم السلام ورحمة الله وبركاته ,, تصدقني لو قلت لك اني قرأت الطلب أكثر من مرة وما توضحت لي الفكرة الآن لما تسجل طالب جديد ، ولنفترض انه رقمه حتماً بيكون 31 بناءً على السجلات اللي عندك في الملف المرفق . ولنفترض ايضاً ان اسم الطالب وسام في الصف الأول أ ... إلخ . السؤال اللولبي هو انت محتاج يكون ترتيب السجلات في الجدول أبجداً حسب اسم الطالب ولا أنا فهمت غلط ؟؟

وعليكم السلام ورحمة الله وبركاته .. استخدم في الزر هذا الكود :- Private Sub upx_Click() Dim raten As Double raten = Nz(Me.rxy, 0) If raten = 0 Then MsgBox "Raten يرجى إدخال قيمة صحيحة في مربع النص", vbExclamation, "تنبيه" Me.rxy.SetFocus Exit Sub End If CurrentDb.Execute "UPDATE tbfr SET rx = ratex * " & raten & ", ry = ratey * " & raten, dbFailOnError Me.Requery End Sub استعلام تحديث داخل الزر يقوم بالمطلوب ,,

تم التعديل بإذن الله .. تم التعديل بحيث عند استرجاع فاتورة ( جرب على الفاتورة رقم 4 حيث تم التعديل للتاريخ = 2024-11-16 للتجربة) ، سيتم سؤال المستخدم انه هذه الفاتورة مضى عليها أكثر من 30 يوم ، هل تريد الحذف ( الأمر متروك للمستخدم بالحذف أو لا ..) في اي جزء لاحظت انه لا يتم الترحيل بشكل صحيح ...؟ فبناءً على الملف المرفق تمت التجربة على السجلات بشكل منفصل والتدقيق قبل وبعد الترحيل أو الإستيراد . اذا تمكنت من ارفاق صورة أو توضيح لتلافي المشكلة ، وأكيد في الأمور المالية والحسابية الخطأ يكون قاتلاً Zakat.zip

وعليكم السلام ورحمة الله وبركاته أستاذ @سلمان الشهراني ، لي مداخلة بسيطة :- في مثالك لاحظت ان رقم الفاتورة مكرر في سجلات القاعدة الأولى ، هل هذا منطقي أم هو مجرد مثال ؟؟ في حال كان هو فعلاً كذلك ، فعلى أي أساس نريد استرجاع فاتورة محددة قد يكون لها سجلات مكررة بنفس رقم الفاتورة ؟؟؟؟؟ على العموم إليك اقتراحي :- في زر الترحيل الى القاعدة الأولى استخدم الكود التالي :- Private Sub COM1_Click() On Error GoTo ErrorHandler Dim db1 As DAO.Database Dim db2 As DAO.Database Dim rst1 As DAO.Recordset Dim rstCheck As DAO.Recordset Dim strSQL As String Dim strCheck As String Dim strPath2 As String Dim intCount As Integer strPath2 = CurrentProject.Path & "\Zakat2.accdb" Set db1 = CurrentDb Set db2 = DBEngine.OpenDatabase(strPath2) strCheck = "SELECT COUNT(*) AS NewCount " & _ "FROM TBInvoiceMain " & _ "WHERE ID NOT IN " & _ "(SELECT ID FROM [;DATABASE=" & strPath2 & "].TBInvoiceMain2)" Set rstCheck = db1.OpenRecordset(strCheck) If Not rstCheck.EOF Then If rstCheck!NewCount = 0 Then MsgBox "لا توجد فواتير جديدة للترحيل", vbInformation + vbMsgBoxRight, "" GoTo CleanUp End If If MsgBox("سيتم نقل " & rstCheck!NewCount & " فاتورة . هل تريد المتابعة؟", _ vbQuestion + vbMsgBoxRight + vbYesNo, "") = vbNo Then GoTo CleanUp End If End If strSQL = "SELECT DISTINCT TBInvoiceMain.* " & _ "FROM TBInvoiceMain " & _ "WHERE InvoiceNumber NOT IN " & _ "(SELECT InvoiceNumber FROM [;DATABASE=" & strPath2 & "].TBInvoiceMain2)" Set rst1 = db1.OpenRecordset(strSQL) intCount = 0 If Not rst1.EOF Then Do While Not rst1.EOF On Error Resume Next strSQL = "INSERT INTO [;DATABASE=" & strPath2 & "].TBInvoiceMain2 " & _ "SELECT ID, ID2, InvoiceNumber, FormNumber, InvoiceType, UUID, " & _ "InvoiceSerial, InvoiceDate, InvoiceTime, InvoiceTypeCodeID, " & _ "InvoiceTypeCodeName, InvoiceHash, DateSupply, EndDateSupply, " & _ "PaymentMethod, InstructionNote, TotalDiscount, DiscountReason, " & _ "TaxCode, TaxCodeName, TaxPercentage, InvoiceQR, InvoiceXmlName, " & _ "InvoiceXmlFullPath, EncodedInvoice, XMLCreated, SendingStatus, " & _ "ZatcaStatusCode, ZatcaXMLSent, ZatcaWarningMessage, ZatcaErrorMessage, " & _ "ClearedInvoice, BuyerStreetName, BuyerAdditionalStreetName, " & _ "BuyerBuildingNumber, BuyerPlotIdEntification, BuyerCityName, " & _ "BuyerPostalCode, BuyerCountrySubEntity, BuyerCitySubDivisionName, " & _ "BuyerCompanyName, BuyerTaxNumber, clearedXmlFullPath, BuyerCommercialRegistrationNo " & _ "FROM TBInvoiceMain WHERE InvoiceNumber = " & rst1!InvoiceNumber db1.Execute strSQL If Err.Number = 0 Then strSQL = "INSERT INTO [;DATABASE=" & strPath2 & "].TBInvoiceSub2 " & _ "SELECT ID, InvoiceNumber, ItemName, Quantity, ItemPriceBeforeTax, " & _ "TaxPercentage, TaxCode, Discount " & _ "FROM TBInvoiceSub WHERE InvoiceNumber = " & rst1!InvoiceNumber db1.Execute strSQL If Err.Number = 0 Then intCount = intCount + 1 End If End If On Error GoTo ErrorHandler rst1.MoveNext Loop strSQL = "DELETE TBInvoiceSub.* " & _ "FROM TBInvoiceSub INNER JOIN TBInvoiceMain ON TBInvoiceMain.ID = TBInvoiceSub.ID " & _ "WHERE DateDiff('d', TBInvoiceMain.InvoiceDate, Date()) > 30" db1.Execute strSQL strSQL = "DELETE TBInvoiceMain.* " & _ "FROM TBInvoiceMain " & _ "WHERE DateDiff('d', InvoiceDate, Date()) > 30" db1.Execute strSQL If intCount > 0 Then MsgBox "تم ترحيل " & intCount & " فاتورة بنجاح" & vbCrLf & _ "وتم حذف الفواتير الأقدم من 30 يوم", vbInformation + vbMsgBoxRight, "" Else MsgBox "لم يتم ترحيل أي فواتير", vbInformation + vbMsgBoxRight, "" End If End If CleanUp: If Not rst1 Is Nothing Then rst1.Close If Not rstCheck Is Nothing Then rstCheck.Close Set rst1 = Nothing Set rstCheck = Nothing If Not db2 Is Nothing Then db2.Close Set db2 = Nothing Exit Sub ErrorHandler: MsgBox "حدث خطأ أثناء عملية الترحيل", vbCritical + vbMsgBoxRight, "" Resume CleanUp End Sub أما في نموذج استرجاع رقم فاتورة محدد ، استخدم الكود التالي :- Private Sub COM1_Click() On Error GoTo ErrorHandler If IsNull(Me.Text1) Or Trim(Me.Text1) = "" Then MsgBox "الرجاء إدخال رقم الفاتورة المطلوب استرجاعها", vbExclamation + vbMsgBoxRight, "" Me.Text1.SetFocus Exit Sub End If If Not IsNumeric(Me.Text1) Then MsgBox "الرجاء إدخال رقم فاتورة صحيح", vbExclamation + vbMsgBoxRight, "" Me.Text1.SetFocus Exit Sub End If Dim db1 As DAO.Database Dim db2 As DAO.Database Dim rst1 As DAO.Recordset Dim strSQL As String Dim strPath2 As String Dim lngInvoiceNumber As Long strPath2 = CurrentProject.Path & "\Zakat2.accdb" lngInvoiceNumber = CLng(Trim(Me.Text1)) Set db1 = CurrentDb Set db2 = DBEngine.OpenDatabase(strPath2) strSQL = "SELECT COUNT(*) AS InvCount " & _ "FROM [;DATABASE=" & strPath2 & "].TBInvoiceMain2 " & _ "WHERE InvoiceNumber = " & lngInvoiceNumber Set rst1 = db1.OpenRecordset(strSQL) If rst1!InvCount = 0 Then MsgBox "الفاتورة رقم " & lngInvoiceNumber & " غير موجودة في قاعدة البيانات الثانية", vbExclamation + vbMsgBoxRight, "" GoTo CleanUp End If strSQL = "SELECT COUNT(*) AS InvCount FROM TBInvoiceMain " & _ "WHERE InvoiceNumber = " & lngInvoiceNumber Set rst1 = db1.OpenRecordset(strSQL) If rst1!InvCount > 0 Then If MsgBox("الفاتورة موجودة بالفعل في القاعدة الحالية . هل تريد استرجاعها مرة أخرى؟", _ vbQuestion + vbYesNo + vbMsgBoxRight, "") = vbNo Then GoTo CleanUp End If End If strSQL = "INSERT INTO TBInvoiceMain " & _ "SELECT * FROM [;DATABASE=" & strPath2 & "].TBInvoiceMain2 " & _ "WHERE InvoiceNumber = " & lngInvoiceNumber db1.Execute strSQL strSQL = "INSERT INTO TBInvoiceSub " & _ "SELECT * FROM [;DATABASE=" & strPath2 & "].TBInvoiceSub2 " & _ "WHERE InvoiceNumber = " & lngInvoiceNumber db1.Execute strSQL MsgBox "تم استرجاع الفاتورة رقم " & lngInvoiceNumber & " بنجاح", vbInformation + vbMsgBoxRight, "" Me.Text1 = "" Me.Text1.SetFocus CleanUp: If Not rst1 Is Nothing Then rst1.Close Set rst1 = Nothing If Not db2 Is Nothing Then db2.Close Set db2 = Nothing Exit Sub ErrorHandler: MsgBox "حدث خطأ أثناء عملية الاسترجاع", vbCritical + vbMsgBoxRight, "" Resume CleanUp End Sub تم الإعتماد هنا على رقم الفاتورة من الحقل InvoiceNumber ، وأخبرني بالنتيجة . المرفق بعد التعديل .. Zakat.zip .

ما تركت لصاحب الموضوع ولاااااا ذرة أمل

حسناً ، جرب هذه الفكرة الثانية .. ولكني أنصحك بأن أفضل فكرة هي وجود برنامج يستعرض ملفات الـ PDF Private Sub Command44_Click() Dim strFilePath As String Dim strFileName As String Dim objShell As Object strFileName = "iPhone.pdf" strFilePath = "C:\Users\Golden\Desktop\" & strFileName If Dir(strFilePath) > "" Then Set objShell = CreateObject("WScript.Shell") objShell.Run "RUNDLL32 PRINTUI.DLL,PrintUIEntry /k /n ""Default Windows Printer"" """ & strFilePath & """", 1, True Set objShell = Nothing Else MsgBox "لايوجد مرفقات يمكن طباعتها" End If End Sub طبعاً في السطر :- objShell.Run "RUNDLL32 PRINTUI.DLL,PrintUIEntry /k /n ""Default Windows Printer"" """ & strFilePath & """", 1, True سيكون الأمر عند الطباعة ليس بالشكل الصامت ، ولكن للتجربة ، استبدل الرقم 1 في نهاية الكود ، بالرقم 0

مشاركة مع الاستاذ @kkhalifa1960 جرب الكود التالي من احد ملفاتي .. Private Sub Comannd187_Click() Dim strFilePath As String Dim strFileName As String Dim strCommand As String strFileName = "66.PDF" strFilePath = "D:\Pictures\NEW\" & strFileName If Dir(strFilePath) > "" Then strCommand = "print """ & strFilePath & """" Shell strCommand, vbHide Else MsgBox "لا توجد مرفقات يمكن طباعتها" End If End Sub

بما أنه تم اختيار أفضل إجابة ، أنصحك بفتح موضوع جديد والإشارة لهذا الموضوع بالمتابعة .. 😇

هذه محاولتي البسيطة ، ان كان هذا طلبك أخبرني بالنيجة توزيع اللجان.accdb

تحقق من الحدث On Load او ارسل ملفك لرؤيته

اعتقد انك كررت طلبك ولكن بتغيير النموذج وأشياء بسيطة .. لكن تفضل هذا طلبك بطريقة بدائية بسيطة test.accdb

هل المشروع لا يعمل على جهازك الذي صممته عليه ، أم على جهاز آخر ؟؟ A- اذا كان يعمل ثم لم يعد يعمل فجأة على جهازك ، فحاول واحداً منا يلي :- 1. ضغط وإصلاح لقاعدة البيانات. 2. قم باستيراد مكونات قاعدة البيانات إلى قاعدة بيانات جديدة مع تأكدك من المكتبات طبعاً. B- إذا كانت المشكلة في جهاز آخر ، فتفقد لغة الترميز Unicode . الق نظرة على الموضوع التالي .

مشكور على المشاركة الطيبة استاذ أبو أحمد ,, اسمح لي بمداخلة ، وقد توسع الفكرة لأبعد من ذلك ,, جربتها على مثال بسيط مثلاً "مائة وخمسة وعشرون دينار وأربعون فلس" والنتيجة = 125.4 "مئة وخمسة وعشرون دينار وأربعون فلس" والنتيجة = 25.4 "مائة وخمسة وعشرون دينار وأربعين فلس" والنتيجة = 125 "مائة وخمسة وعشرون دينار واربعون فلس" والنتيجة = 125 "مائة وخمسة وعشرين دينار وأربعون فلس" والنتيجة = 105.4 اي باختلاف كتابة التفقيط قد يكون هناك عدة فروقات في النتائج .. *- مجرد رأي ، ولكم جزيل الشكر

مبارك لك حل المشكلة .. ما هو الحل الذي عالج مشكلتك ، اذكره هنا حتى يعرف الحل من يمر من هنا أخي الكريم @Abomuayad2023 .

خلينا على دي .. وبلاش من دي .. بتحسسني انه عندي 99 سنة وانا يا دوبك عندي 98 بس

وأنا فكرتي أني ما غيرتش في طريقة عرض البيانات حسب رغبة صاحب المشروع مراعياً حاجته ، فقد تكون الفكرة عدم إظهار السجلات إلى المفلترة فقط ( خصوصية مثلاً ، أو سجلات كبيرة وكثيرة )

قد تكون المشكلة فعلاً في إصدار الأوفيس للي عندك ( 2013 ) أول إصدار بدون تحديثات ,, جرب تحميل :- هذا الإصدار اوفيس 2010 ( 32 بت ) هذا الإصدار اوفيس 2016 ( 64 بت )

هذه المشكلة تخص مركز التوثيق في آكسيس .. وتفعيل الماكرو أو تأكد من التالي ..

تتعدد الأسباب ، والموت واحد

وعليكم السلام ورحمة الله وبركاته .. تفضل محاولتي البسيطة test.accdb

وعليكم السلام ورحمة الله وبركاته .. تفضل يا صديقي ، تم تعديل الاستعلام في مصدر سجلات التقرير ليصبح :- SELECT info_stagiere.ID, info_stagiere.nom, info_stagiere.prenom, info_stagiere.annee, info_stagiere.grade, [code_grade].[code] & ([code_grade].[numero]+(SELECT COUNT(*) FROM info_stagiere AS T WHERE T.annee = info_stagiere.annee AND T.grade = info_stagiere.grade AND T.ID < info_stagiere.ID)) AS code_stagiere FROM info_stagiere INNER JOIN code_grade ON info_stagiere.grade = code_grade.grade WHERE (((info_stagiere.annee)=[Forms]![frm_stag]![ANNEE1]) AND ((info_stagiere.grade)=[Forms]![frm_stag]![GRADE1])); هل هذا طلبك ؟ baseA.accdb