kanory

اهلا بك اخي احمد لا عليك ... مرحبابك المهم انك وجدت مطلوبك اخي الكريم

اختصارا للوقت ...... جرب المرفق التالي ..... يتم تكوين جدول بالمواد مهما كان عددها في الجدول <><><><><><><><><><><><> KAN_2.accdb

طيب ::::: - كل المجالات في جدول واحد .... بمعني ممكن يكون في الحقل مثلا مادة1 ((اللغة العربية) و (اللغة الانجليزية)) يعني طالب من مجال واخر من مجال اخر ممكن جدول فيه اكثر من مجال اذا كانت المجالات كلها في جدول واحد ... الموجود الان فقط مجال واحد وهو استصلاح الاراضى الصحراوية والميكنة الزراعية حتى نعاين شكل الجدول

الاجابة نعم ........ ولكن اسماء الحقول ( حقول المواد ) هل المرفقة في بداية موضوعك أم هي حقول مجازية وعند التطبيق على مثالك يتوقف الكود الذي نكتبه لك دائما اذكر كل تفاصيل برنامجك حتى لاتقع في الحرج مثل ما فعلت ...... اردت تطبيق المرفق بعد الاجابة على برنامجك فوجدت ان برنامجك يحوى اسماء مواد اخرى وحقول اكثر قبل الاجابة على سؤالك :::: هل جميع جقول المواد لديك تبدا مادة ثم رقم أم ماذا ؟؟؟؟؟؟؟؟؟؟؟؟

تفضل KAN_1.accdb

تفضل جرب المرفق KAN_1.accdb

بارك الله فيك فكرة جيدة .... عند الضغط والاصلاح يفقد الحماية ..... هل جربت الضغط على مفتاح Alt+F11

مشاركة مع الحبايب

في اعلا النموذج لديك ضع دالة Sleep لانها غير موجودة لديك #If VBA7 Then Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) #Else Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) #End If

طيب استخرج المجلد بجوار القاعدة ثم استخدم هذا الكود Sub ExportReports_To_OnePDF_PDFtk() Dim arrReports As Variant Dim i As Integer Dim strTempFolder As String Dim strFinalPDF As String Dim strPDFtk As String Dim strCmd As String strPDFtk = CurrentProject.Path & "\PdftkBuilderPortable\pdftk.exe" strTempFolder = CurrentProject.Path & "\TempPDF\" strFinalPDF = CurrentProject.Path & "\AllReports.pdf" arrReports = Array("rpt1", "rpt2", "rpt3") If Dir(strTempFolder, vbDirectory) = "" Then MkDir strTempFolder End If If Dir(strTempFolder & "*.pdf") <> "" Then Kill strTempFolder & "*.pdf" End If For i = LBound(arrReports) To UBound(arrReports) DoCmd.OutputTo acOutputReport, arrReports(i), acFormatPDF, _ strTempFolder & (i + 1) & "_" & arrReports(i) & ".pdf", False Next i strCmd = """" & strPDFtk & """ " & _ """" & strTempFolder & "*.pdf"" cat output " & _ """" & strFinalPDF & """" Shell strCmd, vbHide MsgBox "تم إنشاء ملف PDF واحد بنجاح ?" & vbCrLf & strFinalPDF, vbInformation Kill strTempFolder & "*.pdf" End Sub PdftkBuilderPortable.rar

استتخدم هذا مع تعدي اسماء التقارير في المصفوفة Sub Export_All_Reports_To_OnePDF() Dim arrReports As Variant Dim i As Integer Dim strFile As String ' أسماء التقارير بالترتيب المطلوب arrReports = Array("Q", "Report2", "Report3") strFile = CurrentProject.Path & "\AllReports.pdf" ' فتح التقارير (مخفية) For i = LBound(arrReports) To UBound(arrReports) DoCmd.OpenReport arrReports(i), acViewPreview, , , acHidden Next i ' دمج وتصدير في ملف واحد DoCmd.OutputTo acOutputReport, arrReports(0), acFormatPDF, strFile, False ' إغلاق التقارير For i = LBound(arrReports) To UBound(arrReports) DoCmd.Close acReport, arrReports(i), acSaveNo Next i MsgBox "تم إنشاء الملف بنجاح", vbInformation End Sub

انشأ مديول وضع فيه هذا Public Sub FillBookmark(BMName As String, BMValue As String) Dim rng As Object If Objwrd.ActiveDocument.Bookmarks.Exists(BMName) Then Set rng = Objwrd.ActiveDocument.Bookmarks(BMName).Range rng.Text = BMValue Objwrd.ActiveDocument.Bookmarks.Add BMName, rng Else MsgBox "Bookmark غير موجود: " & BMName, vbExclamation End If End Sub ثم استخدم هذا في الزر لديك جرب واعلمنا بالنتيجة Private Sub أمر0_Click() On Error GoTo Err_Handler 'فتح ملف الوورد OpenClsword (CurrentProject.Path & "\123.doc") 'تعبئة الـ Bookmarks بدون تكرار Call FillBookmark("AA", txtYear) Call FillBookmark("A1", Format(tx1, "#,##0.00")) Call FillBookmark("A2", Format(tx2, "#,##0.00")) Call FillBookmark("A3", Format(tx3, "#,##0.00")) Call FillBookmark("A4", Format(tx4, "#,##0.00")) Call FillBookmark("A5", Format(tx5, "#,##0.00")) Call FillBookmark("A6", Format(tx6, "#,##0.00")) Call FillBookmark("A7", Format(tx7, "#,##0.00")) Call FillBookmark("A8", Format(tx8, "#,##0.00")) Call FillBookmark("A9", Format(tx9, "#,##0.00")) Exit Sub Err_Handler: MsgBox "حدث خطأ أثناء التصدير إلى الوورد", vbCritical End Sub

هل تريد تصدير هذه التقارير في ملف واحد ام ملفات متعددة

لما لا تستخدم مسح البيانات القديمة وادراج الجديد

استبدل الكود بهذا <><><><><><><> Private Sub أمر0_Click() On Error Resume Next OpenClsword (CurrentProject.Path & "\123.doc") Objwrd.ActiveDocument.Bookmarks("AA").Select Objwrd.Selection.InsertAfter txtYear Objwrd.ActiveDocument.Bookmarks("A1").Select Objwrd.Selection.InsertAfter Format(tx1, "#,##0.00") Objwrd.ActiveDocument.Bookmarks("A2").Select Objwrd.Selection.InsertAfter Format(tx2, "#,##0.00") Objwrd.ActiveDocument.Bookmarks("A3").Select Objwrd.Selection.InsertAfter Format(tx3, "#,##0.00") Objwrd.ActiveDocument.Bookmarks("A4").Select Objwrd.Selection.InsertAfter Format(tx4, "#,##0.00") Objwrd.ActiveDocument.Bookmarks("A5").Select Objwrd.Selection.InsertAfter Format(tx5, "#,##0.00") Objwrd.ActiveDocument.Bookmarks("A6").Select Objwrd.Selection.InsertAfter Format(tx6, "#,##0.00") Objwrd.ActiveDocument.Bookmarks("A7").Select Objwrd.Selection.InsertAfter Format(tx7, "#,##0.00") Objwrd.ActiveDocument.Bookmarks("A8").Select Objwrd.Selection.InsertAfter Format(tx8, "#,##0.00") Objwrd.ActiveDocument.Bookmarks("A9").Select Objwrd.Selection.InsertAfter Format(tx9, "#,##0.00") End Sub

استخدم هذا <><><><><> If Len(Nz(Me.Image.Picture, "")) = 0 Or Dir(Me.Image.Picture) = "" Then Beep MsgBox "لا يمكن طباعة هذا التقرير بدون صورة شخصية ((يرجى اضافة صورة شخصية))" Else RName = "Personel" FldCriteria = "[Key]=" & Me![Key] DoCmd.OpenReport RName, acViewNormal, , FldCriteria End If

تأكد من المرفق المرسل اخي الكريم

تفضل <><><><><><> تصفية في نموذج البحث.accdb

طيب ....... 🤔

جرب المرفق التالي ( طبعا عند تحويل الموظف الى مطوي القيد يختفي من مجموعة الموظفين على رأس العمل ويجده في المطوي قيدهم تحويل.accdb

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

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

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

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

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