Foksh

اعرض الملف ⭐ أداة تحويل ملفات PDF الى صور 2025⭐ أخواني وأساتذتي ومعلمينا ( دون استثناء ) أقدم لكم هدية بسيطة . وهي أداة لتحويل ملفات الـ PDF الى صور ( إستخراج الصفحات الى صور قابلة للإستخدام الحر ) . مميزات الأداة :- الأداة قادرة على التعرف على خصائص ملف الـ PDF الذي تم اختياره مثل ( تاريخ الإنشاء ، عدد الصفحات ، حجم الملف ) . الأداة تعمل بسرعة وكفاءة عالية . الأداة تمت تجربتها على ملف PDF يحتوي 1500 صفحة لفحص سرعة وجودة الصور المستخرجة . الأداة تتيح للمستخدم اختيار مجلد الإستخراج بشكل يدوي ( خاص به ) أو من خلال مجلد ديناميكي يتم انشاؤه بجانب ملف الأداة . الأداة لها إضافات لاحقة ( تحديثات جديدة ) . الأداة لا تقوم بتحويل ملفات الـ PDF إلى ملفات Doc أو Docx . لأن هذه الميزة تتطلب اشتراكات مدفوعة ( رغم علمي بأنه لا يوجد برنامج أو موقع قادر وبشكل صحيح 100% على التعامل مع النصوص العربية داخل ملفات الـ PDF معلومتي قابلة للخطأ والصواب ) . لاحقاً سيتم إضافة ميزة تحويل ودمج الصور التي تم استخراجها الى ملف Doc أو Docx ، بالتعرف الديناميكي على إصدار أوفيس المثبت على الكمبيوتر للمستخدم . صورة توضيحة لعمل الأداة :- تم تسريع الصورة قليلاً لغاية تقليل الحجم بأقصى حد ممكن دون التأثير على جودة الصورة واجهة الأداة :- مرفق ملف PDF تعليمي - للتحربة :- تعلم آكسيس.pdf صاحب الملف Foksh تمت الاضافه 07/25/25 الاقسام قسم الأكسيس  

أخواني وأساتذتي ومعلمينا ( دون استثناء ) أقدم لكم هدية بسيطة . وهي أداة لتحويل ملفات الـ PDF الى صور ( إستخراج الصفحات الى صور قابلة للإستخدام الحر ) . مميزات الأداة :- الأداة قادرة على التعرف على خصائص ملف الـ PDF الذي تم اختياره مثل ( تاريخ الإنشاء ، عدد الصفحات ، حجم الملف ) . الأداة تعمل بسرعة وكفاءة عالية . الأداة تمت تجربتها على ملف PDF يحتوي 1500 صفحة لفحص سرعة وجودة الصور المستخرجة . الأداة تتيح للمستخدم اختيار مجلد الإستخراج بشكل يدوي ( خاص به ) أو من خلال مجلد ديناميكي يتم انشاؤه بجانب ملف الأداة . الأداة لها إضافات لاحقة ( تحديثات جديدة ) . الأداة لا تقوم بتحويل ملفات الـ PDF إلى ملفات Doc أو Docx . لأن هذه الميزة تتطلب اشتراكات مدفوعة ( رغم علمي بأنه لا يوجد برنامج أو موقع قادر وبشكل صحيح 100% على التعامل مع النصوص العربية داخل ملفات الـ PDF معلومتي قابلة للخطأ والصواب ) . لاحقاً سيتم إضافة ميزة تحويل ودمج الصور التي تم استخراجها الى ملف Doc أو Docx ، بالتعرف الديناميكي على إصدار أوفيس المثبت على الكمبيوتر للمستخدم . صورة توضيحة لعمل الأداة :- تم تسريع الصورة قليلاً لغاية تقليل الحجم بأقصى حد ممكن مع محاولة عدم التأثير على جودة الصورة واجهة الأداة :- ملف الأداة بنسختين :- نسخة 64 بت PDF Converter - 64.zip نسخة 32 بت PDF Converter - 32.zip مرفق ملف PDF تعليمي - للتحربة :- تعلم آكسيس.pdf هنا في هذه المشاركة

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

وعليكم السلام ورحمة الله وبركاته .. أخي الفاضل ، الملف المرفق فتح عندي دون ظهور أي مشاكل في اللغة العربية والمسميات كما أرفقت صورتك سابقاً . لذا من الواضح ان مشكلتك في إعدادات الترميز في اللغة العربية .. مشكلتك حلها تقريباً كتطبيق عملي على إصدار ويندوز 10 كما في الصورة التالية :- قد تختلف قليلاً في ويندوز 11 ، ولكن المبدأ واحد ؛ وهو ذهابك الى لوحة التحكم - Control Panel ثم كما في الصورة التالية :- أو ثم اكمل باقي الخطوات كالتالي :- وبعدها سيطلب منك إعادة تشغيل الكمبيوتر لتطبيق التعديلات .

هناك واحد من سببين لهذه المشكلة .. إما أنك قمت بنسخ الأكواد ومؤشر الكتابة ( لغة الكيبورد = انجليزية ) ، وهو هنا مستبعد .. وإما الحل الثاني ويكمن الحل بمراجعة الموضوع التالي :- حيث أنصحك باستخدام آخر إصدار للأداة لضبط لغة الترميز Unicode حسب بلدك .. في هذه المشاركة = الإصدار الأخير ..

وجدت هذا الموضوع ، إن كان يفيدك أيضاً .. وهو تابع لموضوع سابق قمت بالإشارة إليه ..

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

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

وعليكم السلام ورحمة الله وبركاته .. تم إضافة دالة جديدة لإنشاء الجدول المؤقت الجديد "zTempImageReport" ، حيث يتم فيه اضافة سجلات الصور ومساراتها :- Public Function CreateTempImageTable() On Error GoTo ErrorHandler Dim db As DAO.Database Dim tdf As DAO.TableDef Dim fld As DAO.Field Dim tblExists As Boolean Set db = CurrentDb() tblExists = False For Each tdf In db.TableDefs If tdf.Name = "zTempImageReport" Then tblExists = True Exit For End If Next tdf If Not tblExists Then Set tdf = db.CreateTableDef("zTempImageReport") Set fld = tdf.CreateField("ImageName", dbText, 255) tdf.Fields.Append fld Set fld = tdf.CreateField("ImagePath", dbText, 255) tdf.Fields.Append fld Set fld = tdf.CreateField("EmployeeID", dbLong) tdf.Fields.Append fld Set fld = tdf.CreateField("EmployeeName", dbText, 100) tdf.Fields.Append fld db.TableDefs.Append tdf Else db.Execute "DELETE * FROM zTempImageReport", dbFailOnError End If Exit Function ErrorHandler: MsgBox " : حدث خطأ في إعداد الجدول المؤقت" & Err.Description, vbCritical + vbMsgBoxRight, "" Exit Function End Function قمت بإنشاء التقرير "rptImageGallery" ، والذي مصدر سجلاته = الجدول المؤقت السابق "zTempImageReport" ، وفي النموذج في الزر "أمر105" الكود التالي :- Private Sub أمر105_Click() On Error GoTo ErrorHandler If List31.ListCount = 0 Then MsgBox "لا توجد صور ليتم عرضها في التقرير", vbInformation + vbMsgBoxRight, "" Exit Sub End If Call CreateTempImageTable Dim db As DAO.Database Dim rs As Recordset Dim i As Integer Dim ImagePath As String Dim basePath As String basePath = CurrentProject.Path & "\SysFiles\" & Me.ID & "\" Set db = CurrentDb() db.Execute "DELETE * FROM zTempImageReport", dbFailOnError For i = 0 To List31.ListCount - 1 If List31.ItemData(i) <> "" Then ImagePath = basePath & List31.ItemData(i) If Dir(ImagePath) <> "" Then db.Execute "INSERT INTO zTempImageReport " & _ "(ImageName, ImagePath, EmployeeID, EmployeeName) " & _ "VALUES ('" & Replace(List31.ItemData(i), "'", "''") & "', " & _ "'" & Replace(ImagePath, "'", "''") & "', " & _ Me.ID & ", '" & Replace(Me.الاسم, "'", "''") & "')", dbFailOnError End If End If Next i DoCmd.OpenReport "rptImageGallery", acViewPreview Exit Sub ErrorHandler: MsgBox " : حدث خطأ أثناء فتح التقرير" & Err.Description, vbCritical + vbMsgBoxRight, "" End Sub هي فكرة بسيطة تلبي حاجتك ، وتستطيع التعديل عليها حسب حاجتك . الملف بعد التعديل :- الصورة (1).zip

وعليكم السلام ورحمة الله وبركاته 🤗.. لو استخدمت خاصية البحث في المنتدى ، لكنت وجدت الكثير من المشاركات التي تناولت نفس الموضوع ، منها :-

ههههههههه خليها سر ، مش حقولك إزاي 😎

وعليكم السلام ورحمة الله وبركاته .. حاول استخدام المعادلات لسهولتها عليك ، على سبيل المثال ، في الجزء الأول للطرح والنتيجة بين التاريخين :- في النتيجة للأيام :- =DATEDIF(R16, O16, "md") في النتيجة للأشهر :- =DATEDIF(R16, O16, "ym") في النتيجة للسنوات :- =DATEDIF(R16, O16, "y") أما في الجزء الثاني من جمع قيم الى تاريخ للحصول على تاريخ جديد ، استخدم المعادلة التالية :- =DATE(YEAR(O28) + T28, MONTH(O28) + S28, DAY(O28) + R28) أو هذه المعادلة :- =DATE(YEAR(O28) + T28 + INT((MONTH(O28) + S28 - 1) / 12), IF(MOD(MONTH(O28) + S28, 12) = 0, 12, MOD(MONTH(O28) + S28, 12)), DAY(O28) + R28) جرب النتيجة وأخبرنا بها ، في ملفك المرفق التالي :- جمع_.zip

نزلته فعلاً ، بس والله ما جربته .. متخافش على رزقك 😂

حقك علي فعلاً ،، انا افتكرت نفسي عملت اقتباس 😂 قصدي مع مشاركة معلمي الفاضل منتصر

ولو بعد الرسالة اغلقنا التقرير 😅 برضوا هيطبع صفحة فاضية ! 🙄

وعليكم السلام ورحمة الله وبركاته .. حاولت التبسيط لك من خلال المعادلات و وجدت انك ستقوم بتكرار الكثير من المعادلات لكل عمود . لذا خطرت لي فكرة أبسط لك من خلال الكود التالي في زر :- Private Sub CommandButton1_Click() Dim wsSrc As Worksheet, wsDest As Worksheet Dim srcData As Variant, outData() As Variant Dim i As Long, j As Long, outRow As Long Dim lastRow As Long Set wsSrc = ThisWorkbook.Sheets("الوارد") 'تحديد الورقة المصدر Set wsDest = ThisWorkbook.Sheets("مشتريات") 'تحديد الورقة الهدف lastRow = wsSrc.Cells(wsSrc.Rows.Count, "F").End(xlUp).Row srcData = wsSrc.Range("B3:N" & lastRow).Value ' تم التوسيع حتى العمود N (عمود 14) ReDim outData(1 To UBound(srcData), 1 To 13) 'تحديد عدد الأعمدة outRow = 0 For i = 1 To UBound(srcData) If Trim(srcData(i, 5)) = "مشتريات" Then 'تحديد الشرط outRow = outRow + 1 For j = 1 To 13 'تحديد عدد الأعمدة outData(outRow, j) = srcData(i, j) Next j End If Next i If outRow > 0 Then wsDest.Range("B3").Resize(outRow, 13).Value = outData 'تحديد عدد الأعمدة End If End Sub وأضفت لك التعليقات لتفهم الفكرة في حال أردت التنفيذ على أوراق أو أفكار اخرى بتغيير الشروط والهدف والمصدر والأعمدة .... إلخ الملف المرفق ، في الورقة "مشتريات" انقر الزر فقط 😁 . خزينة المشتريات والتراخيص المركزية عام 2025-2026.xlsm

تمام ، هكذا الأمور أوضح للجميع ,, تفضل هذا الكود كاملاً للنموذج بعد التعديل :- Option Compare Database Private m_ImagePath As String Sub ImageLoad() On Error Resume Next m_ImagePath = CurrentProject.Path & "\" & "SysFiles" & "\" & Me.ID List31.RowSource = "" List31.RowSource = Left(GetAllFile(m_ImagePath), Len(GetAllFile(m_ImagePath)) - 1) End Sub Private Sub Command42_Click() On Error Resume Next m_ImagePath = CurrentProject.Path & "\SysFiles\" & Me.ID Dim newFileName As String newFileName = AddNewFile(Me.ID) Image16.Picture = m_ImagePath & "\" & newFileName Call ImageLoad Me.Path = m_ImagePath & "\" & newFileName If Not IsNull(newFileName) Then List31.Value = newFileName End If End Sub Private Sub Command43_Click() On Error Resume Next If IsNull(List31) Then Exit Sub If MsgBox("هل تريد فعلا حذف الصورة المحددة" & vbNewLine & List31, vbMsgBoxRight + vbYesNo + vbQuestion, "تأكيد الحذف") = vbYes Then m_ImagePath = CurrentProject.Path & "\" & "SysFiles" & "\" & Me.ID Kill (m_ImagePath & "\" & List31) Call ImageLoad Image16.Picture = "" Image16.Requery End If End Sub Private Sub Form_Current() On Error Resume Next Call ImageLoad Me.Form.Caption = IIf(IsNull(Me.الاسم), "", Me.الاسم) Image16.Picture = "" Auto_Header0.Caption = "الأرشيف الالكتروني للموظف" & " : " & Me.الاسم End Sub Private Sub List31_Click() On Error Resume Next m_ImagePath = CurrentProject.Path & "\" & "SysFiles" & "\" & Me.ID Image16.Picture = m_ImagePath & "\" & List31 Me.Path = m_ImagePath & "\" & Me.List31 End Sub Private Sub List31_DblClick(Cancel As Integer) On Error Resume Next If IsNull(List31.Value) Or List31.Value = "" Then Exit Sub Dim oldName As String, oldNameWithoutExt As String, fileExt As String Dim filePath As String, newName As String, newNameWithExt As String oldName = List31.Value filePath = CurrentProject.Path & "\SysFiles\" & Me.ID & "\" Dim dotPosition As Integer dotPosition = InStrRev(oldName, ".") If dotPosition > 0 Then oldNameWithoutExt = Left(oldName, dotPosition - 1) fileExt = Mid(oldName, dotPosition) Else oldNameWithoutExt = oldName fileExt = "" End If newName = InputBox("أدخل الاسم الجديد للصورة", "تعديل اسم الصورة", oldNameWithoutExt) If newName = "" Or newName = oldNameWithoutExt Then Exit Sub newNameWithExt = newName & fileExt If Dir(filePath & oldName) <> "" Then If Dir(filePath & newNameWithExt) <> "" And LCase(filePath & newNameWithExt) <> LCase(filePath & oldName) Then MsgBox "! يوجد ملف بهذا الاسم بالفعل", vbExclamation + vbMsgBoxRight, "" Exit Sub End If Name filePath & oldName As filePath & newNameWithExt Call ImageLoad List31.Value = newNameWithExt If Image16.Picture = filePath & oldName Then Image16.Picture = filePath & newNameWithExt Me.Path = filePath & newNameWithExt End If MsgBox "تم تعديل اسم الصورة بنجاح", vbInformation + vbMsgBoxRight, "" Else MsgBox "الصورة التي تحاول تغيير اسمها ، غير موجودة في مجلد الموظف", vbExclamation + vbMsgBoxRight, "" End If End Sub الملف :- الصورة.zip

اخوي بلال ، من باب التوضيح أكثر لك . انت تريد عند النقر مرتين على اسم الصورة ان يتم اظهار رسالة تكتب فيها اسم الصورة الذي تريده ؟؟؟

ما في مشكلة أخي الكريم ، بس سؤالنا ؟ ماذا تريد ان يكون اسم الصورة عند اختيارها ؟؟؟؟؟؟؟؟

بصراحة ما فهمت

لم تقم بتوضيح ماذا تريد ان يكون اسم الصورة ؟ رقم الموظف مثلاً !!!

أولاً ، وعليكم السلام ورحمة الله وبركاته .. ثانياً لا أعتقد أنها صدفة للبيانات التي في السجل الوحيد في الجدول 😅😅 الإسم وتاريخ الميلاد ، والوظيفة 🤔 = جميعها تخصني ( هي ليست سرية ، ولكني استغربت 😁 ) على العموم ، ومشاركة مع معلمي الأستاذ @منتصر الانسي :- لاحظت انك استخدمت تكرار المتغير m مرات عديدة في جميع الأجزاء ، ولذا أقترح عليك ان تقوم بتعريفه كمتغير في بداية النموذج لتخزين مسار الملفات . وهذا مقترحي كاملاً بعد إجراء بعض التغييرات :- Option Compare Database Private m_ImagePath As String Sub ImageLoad() On Error Resume Next m_ImagePath = CurrentProject.Path & "\" & "SysFiles" & "\" & Me.ID List31.RowSource = "" List31.RowSource = Left(GetAllFile(m_ImagePath), Len(GetAllFile(m_ImagePath)) - 1) End Sub Private Sub Command42_Click() On Error Resume Next m_ImagePath = CurrentProject.Path & "\SysFiles\" & Me.ID Dim newFileName As String newFileName = AddNewFile(Me.ID) Image16.Picture = m_ImagePath & "\" & newFileName Call ImageLoad Me.Path = m_ImagePath & "\" & newFileName If Not IsNull(newFileName) Then List31.Value = newFileName End If End Sub Private Sub Command43_Click() On Error Resume Next If IsNull(List31) Then Exit Sub If MsgBox("هل تريد فعلا حذف الصورة المحددة" & vbNewLine & List31, vbMsgBoxRight + vbYesNo + vbQuestion, "تأكيد الحذف") = vbYes Then m_ImagePath = CurrentProject.Path & "\" & "SysFiles" & "\" & Me.ID Kill (m_ImagePath & "\" & List31) Call ImageLoad Image16.Picture = "" Image16.Requery End If End Sub Private Sub Form_Current() On Error Resume Next Call ImageLoad Me.Form.Caption = IIf(IsNull(Me.الاسم), "", Me.الاسم) Image16.Picture = "" Auto_Header0.Caption = "الأرشيف الالكتروني للموظف" & " : " & Me.الاسم End Sub Private Sub List31_Click() On Error Resume Next m_ImagePath = CurrentProject.Path & "\" & "SysFiles" & "\" & Me.ID Image16.Picture = m_ImagePath & "\" & List31 Me.Path = m_ImagePath & "\" & Me.List31 End Sub

أخي الكريم ، اذا كنت تريد التنفيذ من خلال الزر ويكون كما في فكرة الأستاذ @Barna ، فتفضل هذا الحدث جربه ، وأخبرنا بالنتيجة :- Public Sub UpdateFinalGrades() Dim db As DAO.Database Dim rs As DAO.Recordset Dim strSQL As String Dim fld As DAO.Field Dim subjects As Variant subjects = Array("Arb", "Math", "Drast", "Since", "Eng", "Comp", "Skills", "Den") On Error GoTo ErrorHandler Set db = CurrentDb() strSQL = "SELECT * FROM data_dor2 WHERE name_student <> 'IsNull'" Set rs = db.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges) If rs.RecordCount = 0 Then MsgBox "لا توجد سجلات ليتم تحديثها", vbInformation + vbMsgBoxRight, "" Exit Sub End If Do Until rs.EOF For Each subj In subjects Dim dor1 As String, dor2 As String, final As String dor1 = "Dor_" & subj dor2 = "TDor_" & subj final = "N_" & subj If Nz(rs.Fields(dor1).Value, 0) = -1 Or Nz(rs.Fields(dor2).Value, 0) = -1 Then rs.Edit rs.Fields(final).Value = -1 rs.Update Else Dim grade As Double If IsNumeric(rs.Fields(dor1).Value) Then If rs.Fields(dor1).Value >= 50 Then grade = rs.Fields(dor1).Value Else If IsNull(rs.Fields(dor2).Value) Then grade = 0 ElseIf rs.Fields(dor2).Value >= 50 Then grade = 50 Else grade = rs.Fields(dor2).Value End If End If rs.Edit rs.Fields(final).Value = grade rs.Update End If End If Next subj rs.MoveNext Loop DoCmd.Requery MsgBox "تم تحديث جميع الدرجات بنجاح", vbInformation + vbMsgBoxRight, "" Exit Sub ErrorHandler: MsgBox " : حدث خطأ" & Err.Description, vbCritical + vbMsgBoxRight, "" rs.CancelUpdate If Not rs Is Nothing Then rs.Close Set rs = Nothing Set db = Nothing End Sub تستطيع استخدامه في مديول واستدعائه من خلال الزر بإسم الدالة فقط :- Private Sub أمر309_Click() UpdateFinalGrades End Sub أما استعلام التحديث السابق فتجاهله ، وجرب الطريقة الحالية . الملف المرفق قبل لا أنسى 😅 cont0.zip

الحاجة أم الأختراع