Foksh

في الرابط التالي ، سلسلة من دروس الأستاذ محمود عبدالغفار ، متأكد أنها ستقدم لك الإجابات الشافية بشكل مرئي .. https://www.youtube.com/hashtag/mahmoudtrainingmicrosoftvba_dao والدرس الأول أعتقد جواب لسؤالك

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

وعليكم السلام ورحمة الله وبركاته .. حياكم الله أخي أسعد ، الأداة منفصلة بذاتها للآن .. تستطيع استدعائها وفتحها من خلال زر مثلاً بأحد الخيارين التاليين :- On Error GoTo ErrorHandler Dim dbPath As String dbPath = CurrentProject.Path & "\PDF Converter - 64.accde" Application.FollowHyperlink dbPath Exit Sub ErrorHandler: MsgBox "حدث خطأ أثناء محاولة فتح قاعدة البيانات" & vbCrLf & Err.Description, _ vbExclamation + vbMsgBoxRight, "خطأ" أو استخدام الكود التالي :- On Error GoTo ErrorHandler Dim dbPath As String Dim ws As Object dbPath = CurrentProject.Path & "\PDF Converter - 64.accde" If Dir(dbPath) = "" Then MsgBox "ملف قاعدة البيانات غير موجود", vbExclamation Exit Sub End If Set ws = CreateObject("WScript.Shell") ws.Run Chr(34) & dbPath & Chr(34) Set ws = Nothing Exit Sub ErrorHandler: MsgBox "حدث خطأ أثناء فتح قاعدة البيانات" & Err.Description, vbExclamation + vbMsgBoxRight, "خطأ" Set ws = Nothing مع ضرورة تغيير اسم قاعدة البيانات في الكود ، وحيث أن مسار المشروع سيكون بجانب قاعدة بياناتك . وكلاهما يعملان ولكن الكود الأول قد ينتج عنه رسالة التنبيه هذه على سبيل المثال :- والسبب في بعض الأجهزة ونسخ الأوفيس عدم تعيين موقع قاعدة البيانات كمصدر موثوق ، لذا في الكود الثاني سيتجاوز هذا التحذير فقط لا غير ..

أسعدكم الله أخي @Hamtoooo ، وبإذن الله قريباً جداً مميزات وتحسينات وإضافات جديدة ترقى بكم وبهذا المنتدى .

في التحديث الجديد تم إضافة ميزات وتحسينات كثيرة إن شاء الله 😇 . قريباً بإذن الله

وعليكم السلام ورحمة الله وبركاته.. في زر *اعرض هذا الملف* ، ثم الزر "حمل هذا الملف*

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

تم طرح نفس المشكلة تقريباً في موضوع قديم هنا :- وللأسف كانت فكرتك مبنية على أنك لا تريد أن يتم الغاء التنشيط أو الرول باك .. صحيح !!

هذه بسيطة إن شاء الله ,, لكن تعليقي على هذه :- حيث ان عند تحويل الأوقات الى دقائق :- 300 + 360 + 300 + 300 + 389 + 300 + 375 + 366 + 270 + 380 + 300 + 380 + 375 + 270 + 330 + 300 + 375 + 375 + 300 + 375 + 300 = 7020 دقيقة وعند التحويل بقسمة المجموع على 60 7020 ÷ 60 = 117 ساعة إذاً الناتج يكون 117 ساعة .. أما في طلبك الإضافي :- SELECT Tbl_Salary.Mmonth, Format(Sum(DateDiff("n",[Start_Day],[End_Day]))\60,"00") & ":" & Format(Sum(DateDiff("n",[Start_Day],[End_Day])) Mod 60,"00") AS Total_Work_Time, Count(Tbl_Salary.ID) AS Work_Days, Round(Sum(DateDiff("n",[Start_Day],[End_Day]))/300,2) AS Actual_Work_Days FROM Tbl_Salary GROUP BY Tbl_Salary.Mmonth ORDER BY Min(Tbl_Salary.DDate); Mmonth Total_Work_Time Work_Days Actual_Work_Days May 153:30 28 30.7 June 117:00 21 23.4 July 139:28 25 27.89 August 133:35 23 26.72

وعليكم السلام ورحمة الله وبركاته .. استخدم هذا الاستعلام :- SELECT Tbl_Salary.Mmonth, Format(Sum(DateDiff("n", [Start_Day], [End_Day]))\60,"00") & ":" & Format(Sum(DateDiff("n", [Start_Day], [End_Day])) Mod 60,"00") AS Total_Work_Time, Count(Tbl_Salary.ID) AS Work_Days FROM Tbl_Salary GROUP BY Tbl_Salary.Mmonth ORDER BY Min(Tbl_Salary.DDate); سيعرض لك اسم الشهر ، ومجموع ساعات العمل فيه ، وعدد أيام العمل أيضاً Que_Foksh Mmonth Total_Work_Time Work_Days May 153:30 28 June 117:00 21 July 139:28 25 August 133:35 23 ملفك بعد التعديل :- JO_TIME.zip

وعليكم السلام ورحمة الله وبركاته .. هذه الرسالة تعني ان هناك دالة أو وظيفة أو ماكرو يحمل نفس الإسم : Kh_Date_Gender_Province قد يكون على سبيل المثال اسم الدالة بأحد هذه الخيارات :- Sub Kh_Date_Gender_Province() أو Public Function Kh_Date_Gender_Province تحقق من أن اسم الدالة غير مكرر في نفس الأكواد

وعليكم السلام ورحمة الله وبركاته ,, حل مشكلتك إن شاء الله بسيط . في المديول اللي في مشروعك الرئيسي ، انقل الدالة التالية :- Public Function RowNum(frm As Form) As Variant On Error GoTo Err_RowNum With frm.RecordsetClone .Bookmark = frm.Bookmark RowNum = .AbsolutePosition + 1 End With Exit_RowNum: Exit Function Err_RowNum: If Err.Number <> 3021& Then Debug.Print "RowNum() error " & Err.Number & " - " & Err.Description End If RowNum = Null Resume Exit_RowNum End Function الآن في النموذج استدعي الدالة التالية في مربع النص الذي تريد الترقيم فيه بدلاً من القديمة :- =RowNum([Form]) وأخبرنا بالنتيجة

أنا مركز معاك وبكل حرف وزي ما تحب وزيادة 😎 شكراً لك ولمصدر معلوماتك على هذه المداخلة 😏

شكراً لك على أفادتي بالنتيجة ، وإن شاء الله قريباً إصدار جديد بمميزات خدمية شاملة . أما فيما يخص :- هناك كثير من الأسباب التي تجعل من مستخدمي أوفيس يستخدمون الإصدارات 32-بت ، أذكر لك منها - وليس عموماً - ما يلي :- التوافق مع الإضافات Add-Ins والمكتبات الخارجية . والسبب أن الكثير من هذه الإضافات والمكتبات تعمل بشكل فعال وثابت على الإصدار 32-بت مثل :- ( ActiveX و DLLs و COM ) . في البرامج والمشاريع الكبيرة آكسيس 32-بت يعتبر أكثر استقراراً وثباتاً .. والنقطة المهمة بنظري أنه إذا أنشأت برنامجك بـنسخة 32-بت ، فثق تماماً بأنه سيعمل على آكسيس 32-بت و 64-بت = ( النواتين ) دون حاجتك لتغيير أو إعادة كتابة الأكواد بسبب عدم توافق PtrSafe أو تغيير بعض أنواع البيانات ( مثل Long إلى LongPtr ) ... والعديد غيرها . رأيي الشخصي ، هذه النقطة ليست عميقة بما يكفي ، لأن هدف المبرمج ليس استعراض حداثة النسخة أو نواة النظام أمام المستخدم ، بل تقديم حل مستقر وثابت خالي من الأخطاء والمشاكل ، قابل للصيانة ، وسهل التوزيع على شريحة واسعة من المستخدمين . من وجهة نظر عملية ، إذا كانت النتيجة النهائية واحدة - سواء بُنيت على إصدار قديم أو حديث - فإن الوسيلة المستخدمة تصبح مجرد تفصيل ، وليست مقياساً للذكاء البرمجي . لذلك أختلف معك هنا ، لأن الذكاء الحقيقي يظهر في اختيار الأنسب للواقع ، وليس الأحدث بالضرورة 😁 . 🤗 هذه وجهة نظري وليست ملزمة - وهي قابلة للخطأ أو الصواب - .

لمحة عن التحديث الجديد 😁

هذا لا شك فيه ، وهو فعلاً ما يتم 😇

سأحاول تثبيت نسخة أوفيس 2003 وتجربة حفظ نسخة خاصة منه مع التعديل على الأكواد لتتوافق معه 😅 ، وربنا يستر تحديث جديد إن شاء الله قريباً

وعليكم السلام ورحمة الله وبركاته .. معلمنا الجليل والفاضل .. أنا متفاجئ من هذه العقبات التي تظهر عند محاولتك تجربة الملفات التي أقوم برفعها بصيغة ACCDE ، رغم أني خشيت من رفع الصورة التالية لنفس الملف الذي تم رفعه في المشاركة - وملاحظتي انه يعمل دون مشاكل 😢 . سأحاول في التحديث التالي التحقق بشكل أكثر من طريقة حفظ الملف الى accde .. وأعتذر عن هذه المشكلة التي صادفتها 😇

أخي الفاضل ، وعليكم السلام ورحمة الله وبركاته .. لو انك امعنت النظر في الأكواد لكان الأمر قد تبين لك أين عليك التعديل !!! هل هذه الصورة صحيحة ؟ إن كانت صحيحة ، فقط نفس الكود السابق ولكن نقلب الإشارات الأكبر تصبح أصغر والعكس Private Sub تفصيل_Paint() If Me.B3.Value < 9 Then Me.أمر56.Transparent = True Else Me.أمر56.Transparent = False End If End Sub Private Sub Form_Current() Dim bVisible As Boolean bVisible = (Me.B3.Value > 9 Or IsNull(Me.B3)) With Me.أمر56 .Transparent = Not bVisible .Enabled = bVisible End With End Sub

وعليكم السلام ورحمة الله وبركاته .. هذه فكرة بسيطة تم تنفيذها سابقاً في أحد المشاريع لأحد الأخوة . تتلخص في الحدثين التاليين :- Private Sub تفصيل_Paint() If Me.B3.Value > 9 Then Me.أمر56.Transparent = True Else Me.أمر56.Transparent = False End If End Sub Private Sub Form_Current() Dim bVisible As Boolean bVisible = (Me.B3.Value < 9 Or IsNull(Me.B3)) With Me.أمر56 .Transparent = Not bVisible .Enabled = bVisible End With End Sub الملف بعد التعديل :- 1234 (6).zip

حسناً أخي الكريم ، ما رأيك بتصحيح جزء من المشكلة بحيث تبدأ بفهم كيفية كتابة الأكواد بشكل مفهوم ؟؟ في الكود التالي زر الإضافة في المرحلة الأولى ، وقد أضفت شرحاً بسيطاً أتمنى ان يكون مفهوماً لك . مع العلم ان معظم مشاكلك كانت في تسمية الأوراق ( الورقة1 و الورقة2 ) حيث انهما غير موجودات أساساَ . بل اسمهما الصحيح في ملفك = Sheet1 و Sheet2 ... انظر للكود وحاول مجاراته وفهمه . واستبدله في زر الإضافة وقم بالتنفيذ على باقي الأكواد بأسلوبك الذي فهمته . وإذا استعصى عليك شيء لا تتردد أو تبخل على نفسك بطرح السؤال . Private Sub Cmdadd_Click() Dim wsSource As Worksheet Dim wsTarget As Worksheet Dim lastRow As Long ' هنا سنقوم بتحديد أسماء الأوراق المصدر والهدف Set wsSource = Worksheets("Sheet1") Set wsTarget = Worksheets("Sheet2") ' A هنا سنحاول البحث عن أول صف فارغ وتحديداً من العمود lastRow = 4 ' نبدأ من الصف 4 حسب تصميم الورقة الثانية لديك ' إذا كان الصف 4 غير فارغ ، نبحث عن أول صف فارغ أسفله If wsTarget.Cells(4, "A").Value <> "" Then lastRow = wsTarget.Cells(4, "A").End(xlDown).Row + 1 ' إذا وصلنا إلى نهاية البيانات (أي لا توجد خلايا فارغة) ، نستخدم آخر صف ونضيف له 1 If lastRow > wsTarget.Rows.Count Then lastRow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row + 1 End If End If ' نتأكد من ان النطاق المحدد صحيح ويقع بين 4 وأكبر قيمة يسمح بها اكسل If lastRow < 4 Then lastRow = 4 If lastRow > wsTarget.Rows.Count Then lastRow = wsTarget.Rows.Count 'بدء نقل البيانات من الورقة الأولى إلى الورقة الثانية With wsSource wsTarget.Cells(lastRow, "A").Value = .Range("E5").Value wsTarget.Cells(lastRow, "B").Value = .Range("E7").Value wsTarget.Cells(lastRow, "C").Value = .Range("E9").Value wsTarget.Cells(lastRow, "D").Value = .Range("E11").Value wsTarget.Cells(lastRow, "E").Value = .Range("J5").Value wsTarget.Cells(lastRow, "F").Value = .Range("J7").Value wsTarget.Cells(lastRow, "G").Value = .Range("J9").Value wsTarget.Cells(lastRow, "H").Value = .Range("J11").Value wsTarget.Cells(lastRow, "I").Value = .Range("D13").Value wsTarget.Cells(lastRow, "J").Value = .Range("E13").Value wsTarget.Cells(lastRow, "K").Value = .Range("F13").Value wsTarget.Cells(lastRow, "P").Value = .Range("I13").Value wsTarget.Cells(lastRow, "Q").Value = .Range("J13").Value wsTarget.Cells(lastRow, "R").Value = .Range("K13").Value wsTarget.Cells(lastRow, "W").Value = .Range("D15").Value wsTarget.Cells(lastRow, "X").Value = .Range("E15").Value wsTarget.Cells(lastRow, "Y").Value = .Range("F15").Value wsTarget.Cells(lastRow, "AD").Value = .Range("I15").Value wsTarget.Cells(lastRow, "AE").Value = .Range("J15").Value wsTarget.Cells(lastRow, "AF").Value = .Range("K15").Value wsTarget.Cells(lastRow, "AK").Value = .Range("D17").Value wsTarget.Cells(lastRow, "AL").Value = .Range("E17").Value wsTarget.Cells(lastRow, "AM").Value = .Range("F17").Value wsTarget.Cells(lastRow, "AR").Value = .Range("I17").Value wsTarget.Cells(lastRow, "AS").Value = .Range("J17").Value wsTarget.Cells(lastRow, "AT").Value = .Range("K17").Value wsTarget.Cells(lastRow, "AY").Value = .Range("D19").Value wsTarget.Cells(lastRow, "AZ").Value = .Range("E19").Value wsTarget.Cells(lastRow, "BA").Value = .Range("F19").Value wsTarget.Cells(lastRow, "BF").Value = .Range("I19").Value wsTarget.Cells(lastRow, "BG").Value = .Range("J19").Value wsTarget.Cells(lastRow, "BH").Value = .Range("K19").Value wsTarget.Cells(lastRow, "BM").Value = .Range("D21").Value wsTarget.Cells(lastRow, "BN").Value = .Range("E21").Value wsTarget.Cells(lastRow, "BO").Value = .Range("F21").Value wsTarget.Cells(lastRow, "BT").Value = .Range("I21").Value wsTarget.Cells(lastRow, "BU").Value = .Range("J21").Value wsTarget.Cells(lastRow, "BV").Value = .Range("K21").Value End With ' مسح البيانات من الورقة الأولى On Error Resume Next ' تجاوز الأخطاء مؤقتًا Set rngToClear = wsSource.Range("E5,E7,E9,E11,J5,J7,J9,J11,D13:F13,I13:K13,D15:F15,I15:K15,D17:F17,I17:K17,D19:F19,I19:K19,D21:F21,I21:K21") For Each cell In rngToClear If Not cell.MergeCells Then ' إذا لم تكن الخلية جزءً من دمج cell.ClearContents Else ' إذا كانت الخلية جزءً من دمج cell.MergeArea.ClearContents ' مسح محتوى نطاق الدمج بالكامل End If Next cell On Error GoTo 0 ' إعادة تفعيل مكتشف الأخطاء MsgBox "تم ترحيل البيانات بنجاح", vbInformation + vbMsgBoxRight, "تم" End Sub

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

أعتقد ان البرنامج غير مرفوع في المنتدى سابقاً من طرف الأستاذ @Barna .. يبدو انه خاص به 😇 . حتى أن الصورة التي ارفقها الأستاذ ناقل تحمل تاريخ اليوم 25/07/2025 😁

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