Foksh

3 دقائق مضت, ناقل said:

بعد اذنك سيد @Foksh

 

بالعكس ،، اُسعد بمشاركتكم ..

هي الفكرة انه مش عايز يغير باعدادات او اكواد او برمجة النماذج اللي شغالة معاه تمام ، فبيحاول يوصل لهدفة من خلال النموذج ده .

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

أحد الحلول كما تفضل الاستاذ @ناقل .

وعليكم السلام ورحمة الله وبركاته..

في مديول جديد ، الصق الكود التالي :-

Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long

Sub ClearClipboard()
    If OpenClipboard(0) Then
        EmptyClipboard
        CloseClipboard
    End If
End Sub

ويتم الاستدعاء باسم الصب ClearClipboard

طيب اسمح لي بسؤال غريب شوية ..

المستخدم للبرنامج هيستفيد ايه ؟؟؟؟؟

المفروض الجداول تكون غير ظاهرة ليك كمستخدم !!!!!🙄

إنت بس وصلني للهدف واتركها على الله

30 دقائق مضت, سلمان الشهراني said:

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

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

13 دقائق مضت, 2saad said:

وسام يتسكن ابجديا في الصف الأول  بين ابراهيم وليد               اريج عبدالحميد

فسرها لي دي ..

ابراهيم
وسام
اريج

إزاي !!!!!!!!!!!

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

16 دقائق مضت, ابوخليل said:

لذا تم السطو على كم سطر منها ..  فأعتذر .. زادك الله علما

 

وإياكم أستاذنا الكبير @ابوخليل ، بعض ما عندكم أثابنا وأثابكم الله 

استولي على ما شئت  ، فهذا تعليمكم 

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

6 ساعات مضت, 2saad said:

محتاج كود أو دالة سواء في جدول أو استعلام

وعليكم السلام ورحمة الله وبركاته ,,

تصدقني لو قلت لك اني قرأت الطلب أكثر من مرة وما توضحت لي الفكرة 

الآن لما تسجل طالب جديد ، ولنفترض انه رقمه حتماً بيكون 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

استعلام تحديث داخل الزر يقوم بالمطلوب ,,

3 ساعات مضت, سلمان الشهراني said:

1- امكانية تحديد مسار القاعده Zakat2 ليتم عملية الترحيل والاسترجاع لها ومنها حسب المسار المحدد

3 ساعات مضت, سلمان الشهراني said:

2- اعتماد حقل ID هل حقل الفاتورة ويتم التعامل معه فقط 

تم التعديل بإذن الله ..

4 ساعات مضت, سلمان الشهراني said:

3- عند عملية استرجاع الفاتورة برقم الفاتورة (ID)  للقاعده Zakat1 يتم حذفه مره اخرى من القاعده Zakat1 مع اول عملية حذق بناء على المده 30  مع العلم انه لابد ان يبقى في القاعده Zakat2 بعد الاسترجاع 

تم التعديل بحيث عند استرجاع فاتورة ( جرب على الفاتورة رقم 4 حيث تم التعديل للتاريخ = 2024-11-16 للتجربة) ، سيتم سؤال المستخدم انه هذه الفاتورة مضى عليها أكثر من 30 يوم ، هل تريد الحذف ( الأمر متروك للمستخدم بالحذف أو لا ..)

4 ساعات مضت, سلمان الشهراني said:

4- لوحظ حاليا انه في الجدول الفرعي عند الترحيل لايتم نقلها بالشكل الصحيح كماهي في القاعده الاساسيه

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

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

.

33 دقائق مضت, gavan said:

ارجوا ان وفقت في ايصال القليل من المعلومات الى حضرتك و بالتوفيق الكامل لك  

 

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

حسناً ، جرب هذه الفكرة الثانية ..

ولكني أنصحك بأن أفضل فكرة هي وجود برنامج يستعرض ملفات الـ 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

1 ساعه مضت, كريمو2 said:

هل من مساعدة اساتذة استاذ Barna  يبدو أنه غايب عن المنتدى نتمنى ان يكون بخير

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

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

توزيع اللجان.accdb

48 دقائق مضت, بوكفوس عبدالسلام said:

- بالنسبة للمشروع فهو على جهازي.

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

تحقق من الحدث On Load 

او ارسل ملفك لرؤيته

اعتقد انك كررت طلبك ولكن بتغيير النموذج وأشياء بسيطة ..

لكن تفضل هذا طلبك بطريقة بدائية بسيطة

test.accdb

هل المشروع لا يعمل على جهازك الذي صممته عليه ، أم على جهاز آخر ؟؟

A- اذا كان يعمل ثم لم يعد يعمل فجأة على جهازك ، فحاول واحداً منا يلي :-

1. ضغط وإصلاح لقاعدة البيانات.

2. قم باستيراد مكونات قاعدة البيانات إلى قاعدة بيانات جديدة مع تأكدك من المكتبات طبعاً.

B- إذا كانت المشكلة في جهاز آخر ، فتفقد لغة الترميز Unicode . الق نظرة على الموضوع التالي .

مشكور على المشاركة الطيبة استاذ أبو أحمد ,,

اسمح لي بمداخلة ، وقد توسع الفكرة لأبعد من ذلك ,,

جربتها على مثال بسيط مثلاً

"مائة وخمسة وعشرون دينار وأربعون فلس" والنتيجة = 125.4

"مئة وخمسة وعشرون دينار وأربعون فلس" والنتيجة = 25.4

"مائة وخمسة وعشرون دينار وأربعين فلس" والنتيجة = 125

"مائة وخمسة وعشرون دينار واربعون فلس" والنتيجة = 125

"مائة وخمسة وعشرين دينار وأربعون فلس" والنتيجة = 105.4

اي باختلاف كتابة التفقيط قد يكون هناك عدة فروقات في النتائج ..

*- مجرد رأي ، ولكم جزيل الشكر 

9 دقائق مضت, Abomuayad2023 said:

تم حل الإشكالية بنجاح

مبارك لك حل المشكلة ..

ما هو الحل الذي عالج مشكلتك ،

اذكره هنا حتى يعرف الحل من يمر من هنا أخي الكريم @Abomuayad2023   .

4 دقائق مضت, ابو جودي said:

اخى الحبيب

خلينا على دي ..

وبلاش من دي ..

4 دقائق مضت, ابو جودي said:

استاذى القدير الاستاذ

بتحسسني انه عندي 99 سنة 

وانا يا دوبك عندي 98 بس 

3 دقائق مضت, ابو جودي said:

انا حرصت فقط على اظهار كل البيانات عند فتح النموذج لذلك لم ارد التقيد بالربط بين النموذج الرئيسي والنموذج الفرعى 

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

قد تكون المشكلة فعلاً في إصدار الأوفيس للي عندك ( 2013 ) أول إصدار بدون تحديثات ,,

جرب تحميل :- 

1. هذا الإصدار اوفيس 2010 ( 32 بت )
2. هذا الإصدار اوفيس 2016 ( 64 بت )

7 دقائق مضت, Abomuayad2023 said:

جزاك الله أستاذي @ابو جودي على الإجابة وبالفعل تقريباً انحلت المشكلة الأولى وظهرت لي رسالة أخرى كما هو في الصورة 

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

وتفعيل الماكرو

أو تأكد من التالي ..

34 دقائق مضت, ابو جودي said:

طيب ودى فكرتى 

 

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