د.كاف يار

اليك اسهل الطرق

اضف مربع نص آخر بجانب الأساسي

و لنفرض ان اسمه Text114

و الآن ضع الكود التالي في حدث عند التغيير في مربع النص الاساسي

Dim SetTexta As String
    SetText = cus_name.Text
    Text114 = SetText
    Child1.Form.RecordSource = "SELECT * FROM buy where [bian] Like '*" & Text114 & "*'"
    Child1.Requery

التعديل في المرفقات

Database1 (1).accdb

جرب هذا 

لأنه الكود الي مرفق عندك يحتاج له شغل كثير

تحويل الارقام الى حروف.mdb

تفضل

الايقونة2.zip

جرب هذا 

الايقونة.zip

6 دقائق مضت, شايب said:

وجهة نظر

 

وجهة نظر فنااان و معلم 
مشاء الله لا قوة الا بالله

و فعلا اقتراحك لو اخذ فيه السائل راح يسرع من عمل البرنامج 

حاليا قد يكون سريع لأنه عدد السجلات بسيط لو مع مرور الأيام راح يثقل مع كمية الاستعلامات هذي

فإقتراحك افضل بكثير من الناحية العملية و النظرية و من كل النواحي

انشئ جدول للقيم 

و اربطه بمربح التحرير و السرد 

استخدم الحلول السهلة دائما 

عدل هذا السطر

CurrentProject.Path & "\ضــع هـــنــــــام اســــم الــفــولـــدر\" & [ID] & ".pdf"

ماشاء الله لا قوة الا بالله عمل في قمة الروعة

13 ساعات مضت, سامي الحداد said:

أخي الكريم

تفضل التعديل هل هو المطلوب ؟

الملف تم تجربته على الاوفيس 2021 وحاليا لا املك غير هذه النسخة .

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

bdd2.accdb 580 kB · 8 downloads

يعمل بكفائة 

اذا المشكلة في اعدادات اللغة لدى صاحب الطلب

تفضل استخدم هذا الكود

Dim  i As Integer, rs As Object
Set rs = Me.Grid1.Form.RecordsetClone

Me.Grid1.SetFocus
DoCmd.GoToRecord , , acFirst
    
For i = 0 To rs.RecordCount - 1
    [Forms]![frm1]![Grid1]![prentss] = IIf([Forms]![frm1]![Grid1]![prentss] = True, False, True)
    If i <> rs.RecordCount - 1 Then DoCmd.GoToRecord , , acNext
Next i

BD.2.accdb

اشرح المطلوب بإيجاز

ارفق مثال للملف الاكسل و قاعدة بيانات لها

او قم بربط ملف الاكسل بقاعدة البيانات

تفضل التعديل

الخطأ كان في العلاقة بين الجداول 

تم انشاء علاقة بين جدول الحسابات و جداول الحركات

بعد الربط اصبح الكشف بهذا الشكل

project no 2.zip

اخي الكريم 

تريد تطابق سجلات داخل نموذج مستمر و هذا الأمر لايمكن الا مع التركزي على سجل حدد

لكن لسهل عليك الأمر 

اوجز بإختصار مطلبك و الهدف الذي تريد الوصول اليه

تجريبي.accdb

47 دقائق مضت, Eng.Qassim said:

مرحبا د حسين @د.كاف يار

 

هلا فيك يا بش مهندس قاسم لك وحشه يا غالي

اتوقع فعلا قد يكون السبب ما ذكرته انت و ننتظر توضيح من الاخ 

لكن هل ظهرت لك مشكلة عند فتح الملف او اغلاقه ؟؟

متى يظهر معك الخطأ ؟؟؟

تفضل هذا الترقيم

Dim i As Integer, x As Integer
For i = 1 To 10
    For x = 1 To 5
        Debug.Print "(" & Format(i, "0#") & ")" & Format(x, "0##")
    Next x
Next i

النتيجة

بدون الاقواس

Dim i As Integer, x As Integer
For i = 1 To 10
    For x = 1 To 5
        Debug.Print Format(i, "0#") & "-" & Format(x, "0##")
    Next x
Next i
End Sub

النتيجة

2 ساعات مضت, سامي سامي الجزائر said:

اخي عند يظهر خطأ

 

تفضل هذا التعديل

SetData.accdb

طبعا لا يمكن 
و لكن تستطيع انشاء جدول داخل جدول من خلال اكواد HTML

<table border="1" width="100%">
  <tr>
    <td>Name 1</td>
    <td>Name 2</td>
    <td colspan="2">Name 3</td>
    <td>Name 4</td>
  </tr>

  <tr>
    <td rowspan="3">ITEM 1</td>
    <td rowspan="3">ITEM 2</td>
    <td>name</td>
    <td>price</td>
    <td rowspan="3">ITEM 4</td>
  </tr>
  <tr>
    <td>name</td>
    <td>price</td>
  </tr>
  <tr>
    <td>name</td>
    <td>price</td>
  </tr>
</table>

و النتيجة تكون التالي

ارفق مثالك و سيتم التطبيق عليه انشاء الله

تفضل هذا مثال لتطبيق الكود

تم وضعه في النموذج الرئيسي عند الفتح

ادخل فترة التجربة و يمكن وضعها في الجدول 

SetData.accdb

الطريقة سهلة 

انشئ موديول جديد و الصق فيه الشفرات التالية

Function AddDate(FilePath As String)
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim Fileout As Object
    Set Fileout = fso.CreateTextFile(FilePath, True, True)
    Fileout.Write CDate(Now)
    Fileout.Close
End Function
Function DateReading(FilePath As String) As Date

    Dim fieldname As String
    fieldname = FilePath
    Dim strLineInput As String
    Dim tekst As String
    Dim strLineArray As Variant
    Dim FileNum As Integer

    FileNum = FreeFile()

    Open fieldname For Input As #FileNum

    Do While Not EOF(FileNum)
        Line Input #FileNum, strLineInput

        DateReading = Right(strLineInput, Len(strLineInput) - 2)
    Loop
    Close #FileNum

End Function

الآن مرحلة تنفيذ الكود

الهدف : 

- انشاء ملف نصي يحتوي على التاريخ الحالي

- قراءة الملف النصي و استخراج التاريخ المسجل به

لإنشاء ملف نصي يتحوي على التاريخ الحالي استخدم الكود التالي

Call DateReading(تضع هنا اسم الملف و المسار الذي تريد حفظ الملف فيه)

مثال 
اهنا اختر ان يكون المسار بجوار قاعدة الباينات الحالية
Call DateReading(CurrentProject.Path & "\" & "vba.txt")

لقراءة الملف النصي استخدم الكود التالي

للحصول على التاريخ المسجل في الملف النصي المزروع بجوار الملف النصي
[TextBox1]=DateReading(CurrentProject.Path & "\" & "vba.txt")

الآن تستطيع توظيف الكود بالطريقة التي تناسبك 

قم بإنشاء جدول به تاريخ التسجيل و اجعله مخفياً و ضع شرطاً عند فتح شاشة تسجيل الدخول

و ضع استعلاماً عن تاريخ التسجيل فإن كان لا يوجد تاريخ يتم اضافة تاريخ و نفس هذا التاريخ سيتم تسجيله في الملف النصي

الآن تستطيع وضع شرط عند الفتح في حال ان تاريخ اليوم مساوي للتاريخ الموجود في الملف النصي ان يقوم النظام بإظهار رسالة و انهاء التطبيق

ابدء بالتطبيق و اذا واجهتك صعوبة تجدني في الخدمة 

للاتصال بنفس القاعدة استبدل سطر الخطاء الى

Dim rst As New ADO.Recordset

في 1‏/6‏/2023 at 08:53, kkhalifa1960 said:

نعم @د.كاف يار يعملان لكن من فورم أخر غير مرتبط بالجدول .

هنا اختلف معك تقدر تجعل الكود يعمل و النموذج مفتوح

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

مرفق التطبيق للفكرة

تفعيل وايقاف اضافة سجل للمكرر (2).mdb

للأسف الملف المضغوط لم يفتح معي

لكن تم تطبيق الكود على الملف في ردي السابق

8 ساعات مضت, kkhalifa1960 said:

واذا كان هذا طلبك لا تنسى الضغط على أفضل اجابة .

 

بجدارة تستحق افضل اجابة

شغل مرتب و حترافي تعجبني دائما الحلول الخفيفة و السهلة ماشاء الله لا قوة إلا بالله 

الله يجعل ما تقدمه في موازين حسناتك

حاول اخي الكريم في المرات القادمة ان ترفق مثال مصغر لكي يسهل التعامل معه

تم تطبيق كود اخي @دروب مبرمج على صفحة مردود المبيعات

Database2.rar