دروب مبرمج

جرب هذا التعديل بحث.mdb

تفضل هذه المشاركة مع معلمي الكبير أ. @Foksh للبحث الكي و الجزئي لأي حقل غير الرقمي البحث.accdb

تفضل هذا التعديل انشئ موديول جديد و الصق به الشفرة التالية و استخدمها كيفما شئت ' المجموع للشخص الواحد لسنة محددة Public Function OneYears(SetID As Integer, SetYear As Integer) Dim SetCol As Variant, i As Integer SetCol = Null For i = 1 To 12 SetCol = "[" & MonthToNo(i) & "-" & SetYear & "]" OneYears = OneYears + Nz(DSum(SetCol, "[Year_" & SetYear & "]", "[ID]=" & SetID), 0) Next i End Function ' المجموع لجميع الأشخاص و جميع السنوات Public Function AllYears() Dim SetCol As Variant, i As Integer, x As Integer, SetYear As Integer SetCol = Null For x = 2023 To 2025 For i = 1 To 12 SetCol = "[" & MonthToNo(i) & "-" & x & "]" AllYears = AllYears + Nz(DSum(SetCol, "[Year_" & x & "]"), 0) Next i Next x End Function Public Function MonthToNo(SetMonth As Variant) Select Case SetMonth Case Is = 1: MonthToNo = "Jan" Case Is = 2: MonthToNo = "Feb" Case Is = 3: MonthToNo = "Mar" Case Is = 4: MonthToNo = "Apr" Case Is = 5: MonthToNo = "May" Case Is = 6: MonthToNo = "Jun" Case Is = 7: MonthToNo = "Jul" Case Is = 8: MonthToNo = "Aug" Case Is = 9: MonthToNo = "Sep" Case Is = 10: MonthToNo = "Oct" Case Is = 11: MonthToNo = "Nov" Case Is = 12: MonthToNo = "Dec" End Select End Function مرفق الملف بعد التعديل Fam.mdb

لا بأس الف سلامة عليك الله يجعل ما اصابك اجر و عافية و طهور انشاء الله اللَّهُمَّ رَبَّ النَّاسِ أَذْهِبْ الْبَاسَ اشْفِ وَأَنْتَ الشَّافِي لَا شِفَاءَ إِلَّا شِفَاؤُكَ شِفَاءً لَا يُغَادِرُ سَقَمًا اللَّهُمَّ رَبَّ النَّاسِ أَذْهِبْ الْبَاسَ اشْفِ وَأَنْتَ الشَّافِي لَا شِفَاءَ إِلَّا شِفَاؤُكَ شِفَاءً لَا يُغَادِرُ سَقَمًا اللَّهُمَّ رَبَّ النَّاسِ أَذْهِبْ الْبَاسَ اشْفِ وَأَنْتَ الشَّافِي لَا شِفَاءَ إِلَّا شِفَاؤُكَ شِفَاءً لَا يُغَادِرُ سَقَمًا

سؤال / كيف تعرف ارتباط الصورة بالسجل ؟ بصيغة اخرى / كيف تعرف ان الصورة الأولى في المجلد تخص اي طالب ؟ في اعتقادي ان لا يوجد اجابة بعد هذا الحل الجميل

فعلا نسيت هذه الخطوة تفضل التعديل File3.zip

تفضل التعديل File2.zip

لم ترفق النموذج

تفضل هذا مثال على ما طلبت الاضافة و الحذف (1).accdb

تفضل هذا مثال على الاضافة و الحذف و التعديل و فراغ الحقول لنموذج غير منضم الاضافة و الحذف.accdb

ضع علامة يساوي قبل الأمر فقط

انشئ مديول جديد و الصق فيه الشفرة التالية Public Function Translate(strInput As String, strFromSourceLanguage As String, strToTargetLanguage As String) As String On Error GoTo errorhandle Dim strURL As String Dim objHTTP As Object Dim objHTML As Object Dim objDivs As Object, objDiv As Object Dim strTranslated As String strURL = "https://translate.google.com/m?hl=" & strFromSourceLanguage & _ "&sl=" & strFromSourceLanguage & _ "&tl=" & strToTargetLanguage & _ "&ie=UTF-8&prev=_m&q=" & EncodeQP2(strInput) Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP") objHTTP.Open "GET", strURL, False objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)" objHTTP.Send "" Set objHTML = CreateObject("htmlfile") With objHTML .Open .Write objHTTP.ResponseText .Close End With Set objDivs = objHTML.getElementsByTagName("div") For Each objDiv In objDivs If objDiv.className = "t0" Then strTranslated = objDiv.innerText Translate = strTranslated End If Next objDiv Set objHTML = Nothing Set objHTTP = Nothing errorhandleexit: Exit Function errorhandle: MsgBox Err.Description Resume errorhandleexit End Function Function EncodeQP2(s As String) As String Dim i As Long Dim p1 As Long Dim p2 As Long Dim r As String Dim n As Long For i = 1 To Len(s) n = AscW(Mid(s, i, 1)) If n < 128 Then r = r & "%" & Hex(n) ElseIf n < 2048 Then p1 = n \ 64 r = r & "%" & Hex(p1 + 192) p2 = n Mod 64 r = r & "%" & Hex(p2 + 128) Else End If Next i EncodeQP2 = r End Function و في حصل الاستعلام او النموذج او اي مكان ضع التالي Translate([TextBox1], "auto", "en")

تفضل هذا التعديل برنامج الأرشفة الالكترونية1.accdb

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

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

تفضل التعديل baset.zip ملاحظة في محلها فعلا يوجد تعارض لديه ارشيف صور غير مرتبط بجدول يريد اضافة الصورة لمربع النص في التقرير و لم يتم تحديد صورة معينة لكني جعلت آخر صورة تم اضافتها في المجلد هي الاساسية فعلا يجب على صاحب الموضوع التمعن جيدا في كلامك لأنه هو المنطق بعينه شكرا لك

انشئ جدول للصلاحيات يرتب هذا الجدول بجدول المستخدمين لديك ليكون على النحول التالي توزيع الصلاحيات حسب طبيعة عمل كل مستخدم على النظام انشئ مديول جديد و الصق فيه التالي Public User_NO As Integer Public Function User_Addition() Dim Prmiss As Variant Prmiss = DLookup("Addition", "User_Prmiss", "User_ID=" & User_NO) User_Addition = IIf(Prmiss = -1, True, False) End Function Public Function User_Edite() Dim Prmiss As Variant Prmiss = DLookup("Edite", "User_Prmiss", "User_ID=" & User_NO) User_Edite = IIf(Prmiss = -1, True, False) End Function Public Function User_Delete() Dim Prmiss As Variant Prmiss = DLookup("Delete", "User_Prmiss", "User_ID=" & User_NO) User_Delete = IIf(Prmiss = -1, True, False) End Function و في النموذج في حدث عند الفتح ضع التالي ' صلاحية الإضافة Me.Form.AllowAdditions = User_Addition ' صلاحية التعديل Me.Form.AllowEdits = User_Edite ' صلاحية الحذف Me.Form.AllowDeletions = User_Delete مرفق مثال على ذلك bbb.accdb

تفضل هذا الاقتراح الفكرة هي كالتالي :- - يكن التعديل في جدول مشابه للجدول الرئيسي و مرتبط بالنموذج - في حال وجود تغييرات سيتم تحديث السجلات التي طرأ عليها تغيير bbb.accdb

لست بحاجة لها و في اعتقادي بأنها ليست مجدية و السبب انها بهذه الصورة لا تقوم بإعلامك عن مكان الخطأ في الكود او اثناء تنفيذ الكود و دائما افضل الطريقة التالية On Error GoTo errorhandle \\\\ هنا في تضع الأكواد التي تريد تنفيذها /// errorhandleexit: Exit Sub errorhandle: MsgBox Err.Description ' رسالة الاعلام عن الخطأ Resume errorhandleexit

ضع هذا كود الوظيفة هذا في الموديول Public Function SetFilePath(SetFileName As Variant, SetFolder As Variant) SetFilePath = CurrentProject.Path & "\" & "SysFiles" & "\" & SetFolder & "\" & SetFileName End Function و في التقرير في مصدر الصورة استدعي الوظيفة اعلاه =SetFilePath([Forms]![نموذج1]![List31];[Forms]![نموذج1]![ID]) تمام كذلك تفضل هذا التعديل baset.zip

تفضل التعديل حدد مكان وجود القالب و اسم و موقع حفظ الملف الجديد بهذا الشكل SendData.zip

تفضل مثال ارسال البيانات.zip

تفضل التعديل Emp_0.2.accdb

تفضل التعديل Emp.accdb

تفضل مثال ارسال البيانات.zip