كل الانشطه

حسناً أخي الكريم ، ما رأيك بتصحيح جزء من المشكلة بحيث تبدأ بفهم كيفية كتابة الأكواد بشكل مفهوم ؟؟ في الكود التالي زر الإضافة في المرحلة الأولى ، وقد أضفت شرحاً بسيطاً أتمنى ان يكون مفهوماً لك . مع العلم ان معظم مشاكلك كانت في تسمية الأوراق ( الورقة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

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

السلام عليكم ورحمة الله أشارك معكم اليوم أكواد داخل وحدة نمطية عامة تم تطويرها لتصفية محتويات أي مربع سرد (ComboBox) في أي نموذج بشكل ديناميكي بمجرد الكتابة داخل مربع التحرير والسرد تصفية ديناميكية: يدعم التصفية المتعددة باستخدام أكثر من حقل (مثل الاسم + الرقم القومي) تدعم التصفية على حقل واحد أو حقول متعددة باستخدام نمط LIKE '*...*' وذلك لتتم التصفية بناء على اى جزء من الكلمة الكود داخل الوحده النمطية العامة Option Compare Database Option Explicit Private dictRowSources As Object Private strLastFilterValue As String Private strLastComboName As String Private Sub EnsureDictionary() If dictRowSources Is Nothing Then Set dictRowSources = CreateObject("Scripting.Dictionary") End If End Sub Public Sub ClearComboMemory(ByVal frm As Access.Form) Dim strKey As Variant Call EnsureDictionary For Each strKey In dictRowSources.Keys If Left(strKey, Len(frm.Name) + 1) = frm.Name & "." Then dictRowSources.Remove strKey End If Next End Sub Public Sub FilterCombo(ByVal frm As Access.Form, _ ByVal strComboName As String, _ Optional ByVal strFilterField As String = "") Dim cmb As Access.ComboBox Dim strSourceSQL As String Dim strFilterValue As String Dim strFilteredSQL As String Dim strOrderByClause As String Dim strKey As String Dim objRegex As Object Dim objMatches As Object Dim arrFilterFields As Variant Dim strWhereClause As String Dim i As Long On Error GoTo ExitWithError ' التحقق من صحة النموذج وعنصر التحكم If frm Is Nothing Then MsgBox "النموذج غير صالح.", vbExclamation Exit Sub End If ' Debug.Print "Form: " & frm.Name ' Debug.Print "ComboBox: " & strComboName Set cmb = frm.Controls(strComboName) ' التحقق من مصدر البيانات Call EnsureDictionary strKey = frm.Name & "." & cmb.Name If dictRowSources.Exists(strKey) Then strSourceSQL = dictRowSources(strKey) Else strSourceSQL = Trim(Replace(cmb.RowSource & "", ";", "")) ' إزالة الفاصلة المنقوطة ' Debug.Print "RowSource: " & strSourceSQL If Len(strSourceSQL) = 0 Then MsgBox "مصدر البيانات غير صالح.", vbExclamation Exit Sub End If dictRowSources.Add strKey, strSourceSQL End If ' إعادة تعيين المصدر إذا لم يتم توفير حقل تصفية If Len(strFilterField) = 0 Then If cmb.RowSource <> strSourceSQL Then cmb.RowSource = strSourceSQL End If cmb.Requery cmb.Dropdown strLastFilterValue = "" strLastComboName = strComboName Exit Sub End If ' التحقق من نوع عنصر التحكم النشط If TypeOf Screen.ActiveControl Is Access.TextBox Or TypeOf Screen.ActiveControl Is Access.ComboBox Then strFilterValue = Nz(Screen.ActiveControl.Text, vbNullString) ' Debug.Print "ActiveControl: " & Screen.ActiveControl.Name ' Debug.Print "FilterValue: " & strFilterValue Else ' Debug.Print "ActiveControl is not TextBox or ComboBox" If cmb.RowSource <> strSourceSQL Then cmb.RowSource = strSourceSQL End If cmb.Requery cmb.Dropdown strLastFilterValue = "" strLastComboName = strComboName Exit Sub End If ' إعادة تعيين المصدر إذا كانت القيمة المصفاة فارغة If Len(strFilterValue) = 0 Then If cmb.RowSource <> strSourceSQL Then cmb.RowSource = strSourceSQL End If cmb.Requery cmb.Dropdown strLastFilterValue = "" strLastComboName = strComboName Exit Sub End If ' التحقق مما إذا كانت القيمة المصفاة أو ComboBox قد تغيرت If strFilterValue = strLastFilterValue And strComboName = strLastComboName Then cmb.Requery cmb.Dropdown Exit Sub End If ' استخدام Regex لاستخراج ORDER BY Set objRegex = CreateObject("VBScript.RegExp") With objRegex .Global = True .IgnoreCase = True .Pattern = "\s*ORDER\s+BY\s+.*$" End With Set objMatches = objRegex.Execute(strSourceSQL) If objMatches.Count > 0 Then strOrderByClause = objMatches(0).Value strSourceSQL = Trim(Replace(strSourceSQL, strOrderByClause, "")) Else strOrderByClause = "" End If ' Debug.Print "SourceSQL: " & strSourceSQL ' Debug.Print "OrderBy: " & strOrderByClause ' التحقق من الحقول وإنشاء شرط WHERE لحقول متعددة If Len(strFilterField) > 0 Then arrFilterFields = Split(strFilterField, ",") strWhereClause = "" For i = LBound(arrFilterFields) To UBound(arrFilterFields) Dim strField As String strField = Trim(arrFilterFields(i)) If Len(strField) > 0 Then If Len(strWhereClause) > 0 Then strWhereClause = strWhereClause & " OR " strWhereClause = strWhereClause & strField & " LIKE '*" & Replace(strFilterValue, "'", "''") & "*'" End If Next i If Len(strWhereClause) = 0 Then MsgBox "تعبير التصفية غير صالح: " & strFilterField, vbExclamation Exit Sub End If On Error Resume Next strFilteredSQL = strSourceSQL & " WHERE (" & strWhereClause & ")" & strOrderByClause ' Debug.Print "FilteredSQL: " & strFilteredSQL cmb.RowSource = strFilteredSQL If Err.Number <> 0 Then MsgBox "تعبير التصفية غير صالح: " & strFilterField & vbCrLf & "Error: " & Err.Description, vbExclamation On Error GoTo ExitWithError Exit Sub End If On Error GoTo ExitWithError Else strFilteredSQL = strSourceSQL & strOrderByClause cmb.RowSource = strFilteredSQL End If ' تعيين المصدر المصفى وتحديث واجهة المستخدم cmb.Requery cmb.Dropdown strLastFilterValue = strFilterValue strLastComboName = strComboName Exit Sub ExitWithError: Select Case Err.Number Case 2118 Resume Next Case Else MsgBox "حدث خطأ أثناء التصفية: " & Err.Number & " | " & Err.Description, vbExclamation End Select End Sub الاستدعاء فى النموذج في حدث Click : لإعادة تحميل القائمة الأصلية لمربع السرد عند الضغط عليه ' في حدث Click Private Sub ComboBoxName_Click() FilterCombo Me, "ComboBoxName" End Sub وايضا في حدث KeyUp : لتصفية القيم أثناء الكتابة في مربع السرد حسب حقل واحد ' في حدث KeyUp Private Sub ComboBoxName_KeyUp(KeyCode As Integer, Shift As Integer) FilterCombo Me, "ComboBoxName", "FieldName" End Sub مع امكانية في حدث KeyUp : لتصفية القيم أثناء الكتابة في مربع السرد حسب أكثر من حقل ' في حدث KeyUp لعمل التصفية المتعددة Private Sub ComboBoxName_KeyUp(KeyCode As Integer, Shift As Integer) FilterCombo Me, "ComboBoxName", "FieldName, FieldName2" End Sub تحياتى Filter inside the Combobox.accdb

الله يبارك فيك و يعطيك من فضله الكثير

لقد قمت بالبحث عن البرنامج ولم اجده

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

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

بارك الله فيك والله مجهود رااااااااااااااااااائع

شكرا جزيلا علي اهتمامك بالموضوع وربنا يبارك فيك منتظر ابداع حضرتك

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

تفضل ملف محدث به كل ما طلبت أما بخصوص تعلم الأكواد فالموضوع بسيط و لكن يلزمه شغف التعلم مع المحاولة و الخطأ أجازات 3.xlsm

شاهدت في المنتدى برنامج حماية شبيه لما طلبت اعتقد للاستاذ @Barna بهذه الصورة ..... ابحث عنه في المنتدى .... ,انا ابحث عنه اذا وجدته ادرجه هنا لك ...

الف شكر على مجهودك انا اقصد مراجعة الاكواد فالشيت المرفق اقصد حاولت اني اعمل الشيت المرفق هل هي تعمل بشكل صحيح ام هناك ملاحظات يمكن ان اتعلم منها ماكرو.xlsm

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

اعرض الملف ⭐ أداة تحويل ملفات 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

السلام عليكم لدي برنامج الفترة التجربية البرنامج الاول عند ادخال كود البرنامج يقوم بانشاء كود سيريال البرنامج البرنامج الثاني عند ادخال سيريال البرنامج يتم الدخال عادي اريد استخراج تاريخ السريان والمدة الفترة التجربية ويمكن لي تمديد الفترة التجربية بارك الله فيكم mas_trial.rar

متابع

السلام عليكم ورحمة الله وبركاته لدى ملف اكسيل يحتوى على كود لانشاء ملف باسم خاص ويحفظ فى مسار معين لحد هنا لا توجد مشكله اريد ان انقل مديول رقم1 وكود يعمل فى حدث فتح الملف فى الملف الجديد هل هذا ممكن كود انشاء الملف Sub new_workbook() Dim ws As Worksheet Dim Path As String Path = CreateObject("WScript.Shell").SpecialFolders("startup") & "\" With Workbooks.Add .SaveAs Filename:=(Path & "rd" & ".xlsm"), FileFormat:=52 .Close End With End Sub سعد.xlsm

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

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

وعليكم السلام ورحمة الله وبركاته وبخصوص شرح جملة الاستعلام الموضوع بيعتمد على مقارنة بين سجلات الجدول نفسه باستخدام دالة EXISTS واستعلام فرعي الاستعلام يقوم بتحديث جدول tblEshtrakatTsdeed وبالتحديد الحقل jad بحيث يتم تعيين قيمته إلى True للسجلات التي تستوفي شرط معينه الشرط يعتمد على مقارنة بين سجلات الجدول نفسه من خلال استعلام فرعي Subquery خلينى أفصل مكونات الاستعلام علشان نبسط الدنيا شوية جزء التحديث : UPDATE UPDATE tblEshtrakatTsdeed AS t1 SET t1.jad = True تم استخدام AS t1 لإعطاء الجدول اسم مستعار :t1 لتسهيل الإشارة إليه داخل الاستعلام خاصة عند مقارنة سجلات الجدول نفسه و يتم تعيين قيمة العمود jad إلى True للسجلات التي تحقق الشرط شرط التحديث WHERE EXISTS ( SELECT 1 FROM tblEshtrakatTsdeed AS t2 WHERE t2.usrID = t1.usrID AND t2.lstDate > t1.lstDate ) هذا الشرط يحدد السجلات في الجدول tblEshtrakatTsdeed (المحدد باسم t1) سيتم تحديثها بناء على وجود سجلات أخرى في نفس الجدول المحدد باسم :t2 والتى تحقق شروط معينة دالة EXISTS: تتحقق مما إذا كان هناك سجل واحد على الأقل في الاستعلام الفرعي يحقق الشرط ليتم تحديث السجل في t1 الاستعلام الفرعي: SELECT 1 FROM tblEshtrakatTsdeed AS t2 WHERE t2.usrID = t1.usrID AND t2.lstDate > t1.lstDate SELECT 1: في استعلامات بها دالة EXISTS بدلا من استرجاع بيانات فعلية يتم إرجاع قيمة ثابتة (1) لأننا نهتم فقط بوجود السجل وليس بمحتواه FROM tblEshtrakatTsdeed AS t2: نفس الجدول tblEshtrakatTsdeed ولكن باسم مستعار مختلف:t2 وذلك حتى نستطيع تمييزه عن t1 الشرط: t2.usrID = t1.usrID: يتطابق معرف المستخدم (usrID) بين السجل في t1 والسجل في t2 هذا يعني أننا نبحث عن سجلات لنفس المستخدم t2.lstDate > t1.lstDate: يتحقق مما إذا كان تاريخ السجل في t2 (الموجود في العمود lstDate) أحدث (أكبر) من تاريخ السجل في t1

السلام عليكم انا حاولت ولكن توجد مشكله لا اعرف ما هي ممكن المساعده و حلها وطريقة الحل ماكرو.xlsm

تقريبا المشكلة فالاوفيس جربته على جهاز تاني اشتغل