kanory

12 ساعات مضت, Taher DZ said:

بوركت استاذ على تعبك ولكن عندي مشكلة في تنفيد البروجرسبار  ماعرفت اين تكمن كما في الصورة الرجاء التعديل على المرفق

في اعلا النموذج لديك ضع دالة 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

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

ملف واحد

استتخدم هذا مع تعدي اسماء التقارير في المصفوفة

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

12 ساعات مضت, Taher DZ said:

فكرة استاذ وكيف لي ان انفذها 

انشأ مديول وضع فيه هذا

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

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

إخواني أعضاء المنتدي الكرام بعد سلام الله عليكم ورحمة الله وبركاته

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

يعني بدلا من أيكون تقرير واحد Q يكون  A   b   c   Q 

DoCmd.OutputTo acOutputReport, "Q", acFormatPDF, strPathAndfile, True

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

7 ساعات مضت, Taher DZ said:

هل من شيء يضاف الى الكود يمنع التكرار عند الدخول مرة ثانية او ثالثة اي لاينقل المبلغ مرة ثانية الا اذا كان فيه تعديل يقوم بتعديله واذا لم يكن يتركه على حاله

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

2 ساعات مضت, Taher DZ said:

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

في الاكسس.  4.390.000.00ينقلها في الورد  4390000

استبدل الكود بهذا  <><><><><><><>
 

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

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

هل يصح تغيير الشرط من (Pic1) الى مربع حوار الصورة (Image) اذا كان (Image) يحتوي على صورة اثناء فتج النموذج تتم الطباعة وذا كان لا يحتوي على صور لا تتم الطباعة

استخدم هذا <><><><><>
 

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

11 ساعات مضت, figo82eg said:

ارجو اتلسماعدة حيث لدى جدول بها ألف السجلات لعملاء متعاقدين بتواريخ مختلفة

ما اريده هو استعلام لمعرفى اجمالى التعاقدات خلال السنوات 

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

52 دقائق مضت, Taher DZ said:

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

تفضل <><><><><><>
 

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

منذ ساعه, Taher DZ said:

شكرا استاذ الفكرة كانت تصفية في الفورم فقط

طيب ....... 🤔

1 ساعه مضت, Taher DZ said:

هل لك ملفا مدخرا به المطلوب او تقريبا يؤدي الى الفكرة

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

تحويل.accdb

منذ ساعه, Taher DZ said:

فكيف تكون الفكرة 

من خبرة تصميم قواعد البيانات

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

( علما اني لم افتح المرفق الخاص بك لدم توفر جهاز )

في 21‏/12‏/2025 at 18:02, Foksh said:

جسيداً لفكرة التعامل مع التقرير .. هذه الفكرة المبدأية لشكل التقرير عند فتحه بعد حفظ التصميم ، وتصديره الى ملف PDF ..

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

1 ساعه مضت, ابوخليل said:

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

سوف افتح موضوعا جديدا واطرح آخر تعديل ثم انتظر اضافاتك ولمساتك

وهكذا حتى يخرج بثوب مناسب

ما رأيك ؟

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

في 18‏/12‏/2025 at 15:51, خالد عبد الغفار said:

عندما اكون قد انهيت هذه المسابقه بشكلها الحالى

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

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

لكن خطر في بالي سؤال .... هل من حق المتقدم للمسابقة العودة الى اجاباته للتعديل ضمن الوقت المسموح له ام هي اجابة وحيدة ....
 

4 ساعات مضت, Eng.Qassim said:

ارجوكم ان تدعوا لوالدتي ... فهي اعز انسان على قلبي

: "أذهب البأس رب الناس، اشف أنت الشافي، لا شفاء إلا شفاؤك، شفاءً لا يغادر سقما

اللهم اشف اخانا قاسم ووالدته وجميع مرضى المسلمين

هل هذه الفكرة هي المطلوبة بالنسبة للعد التنازلي ::::

لاحظ العد يتوقف لحظة فرز الاسئلة العشوائي حفاظا على وقت المتسابق .... ويعود العد مرة اخرى ..... طبعا سرعت واختصرت الوقت عشان الملف لا يصبح كبير
 

18 ساعات مضت, خالد عبد الغفار said:

لكن طلب منى بعض التعديلات  موجوده داخل كل نموذج ارجو ممن ليديهم الخبره وهم كثر المساعده فى هذه التعديلات

وحدة وحدة ..... استاذ @خالد عبد الغفار
ماهي الطلبات ؟؟؟ وهل هذه الطلبات غير موجودة في النسخة الاساسية للمسابقة ؟!
 

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

ند النقر على الزر يفتح مربع حوار اكسس ، وعند النقر على  Open يتم فتح المرفق

المطلوب :

لا اريد ظهور مربع حوار اكسس

اريد ان يتم فتح المرفق من الزر مباشرة 

وعليكم السلام اهلا بك استاذي القدير @ابوخليل

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

Private Sub cmdOpenAttachment_Click()

    Dim rs As DAO.Recordset2
    Dim rsA As DAO.Recordset2
    Dim fld As DAO.Field2
    Dim tmpPath As String
    Dim fileName As String

    'افتح السجل الحالي
    Set rs = Me.Recordset
    
    'اسم الحقل الذي يحتوي على المرفق
    Set fld = rs.Fields("MyAttachmentField")   '← غيّر الاسم حسب جدولك

    If fld.Value Is Nothing Then
        MsgBox "لا يوجد مرفق لفتحه.", vbExclamation
        Exit Sub
    End If

    'افتح المرفق داخل الحقل
    Set rsA = fld.Value

    If rsA.RecordCount = 0 Then
        MsgBox "لا يوجد مرفق.", vbExclamation
        Exit Sub
    End If

    rsA.MoveFirst

    'الاسم الأصلي للمرفق
    fileName = rsA.Fields("FileName").Value

    'حدد مسار مجلد مؤقت
    tmpPath = Environ("TEMP") & "\" & fileName

    'احفظ المرفق كملف مؤقت
    rsA.Fields("FileData").SaveToFile tmpPath

    'افتح الملف بالبرنامج الافتراضي
    FollowHyperlink tmpPath

End Sub

2 ساعات مضت, ابوخليل said:

قمت بحفظ ايقونة في حقل مرفقات (Attachment) في جدول من اجل استخدامها في اماكن متعددة في البرنامج

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

واستخدمت هذا الكود لكنه لم يعمل

هل المطلوب ايقونة واحدة ام ممكن ان تكون اكثر من واحدة

6 دقائق مضت, طاهر اوفيسنا said:

ياسبحان الله استاذي لقد تم حذف كل ماتم تعديله من طرفك فاصبح المرفق يشتغل عادي 

شي عجيب 😙

هات ماعندك لنرى ابتكارك استاذ 💐

وهل عرفت السبب ؟؟؟؟؟؟؟
هو هذا حلي الجديد !!!! هههههههه

وايضا هناك حل ثالث ؟؟؟ 

تفضل اولا الحل الثالث باستخدام 
 

Private Sub Form_Open(Cancel As Integer)
Dim SQL As String

SQL = "SELECT Nom_Menha, Menha_ID, ID FROM Qry_menha " & _
      "WHERE Menha_ID = '" & Forms!FrmMenah!Etar.Column(1) & "' " & _
      "ORDER BY Menha_ID;"

Me.Menha_Name.RowSource = SQL

End Sub

اما الحل الثاني والذي اكتشفته انت اريدك ان تعرفة بنفسك !!!

تغير المصدر3.mdb

4 دقائق مضت, طاهر اوفيسنا said:

قمت بإنشاء مربع نص غير منظم مخفي وسميته KA  وعملت المعيار بالنموذج Frm_MenhaRules

كما تم تعريف ME.KA

اخي طاهر ايضا هناك طريقة اخرى وبدون ادراج مربع النص

اذا تريدها ارفقها لك ابشر