نجوم المشاركات

السلام عليكم 🙂 هذه طريقتي لتفكيك الحقل الى حقول 🙂 نأخذ المرفق كالمثال من هذا الرابط : . هكذا تبدو السجلات ، بالعين المجردة : . والمطلوب ان نقسم بيانات السجل الواحد الى: الاسم ورقم التسلسل (وخلينا نستخدم السجل الاول كمثال) ، ونريد النتيجة تكون : . هناك طريقتين لفرز هذه البيانات : عن طريق كود ليقرأ الحروف/الارقام/العلامات واحدا واحدا ، ثم بوضع شروط اذا جصلنا على رقم ، فنتوقف ونحفظ الجزء الاول ، ثم نواصل ... ، وهذه العملية مرهقة وتحتاج الى تفاصيل كثيرة ، عن طريق الكود ، ولكن بإستخدام الدالة Split ، ويشترط فيها ان نعرف اين (بعد اي حرف/رقم/علامات) نقسم السطر ، ولنسمية شرط القطع . سنتعامل مع الطريقة الثانية وهي الاسهل 🙂 لمعرفة شرط القطع ، يمكننا ان نتعامل مع الحروف/الارقام/العلامات مباشرة ChrW ، او نتعامل مع ارقام هذه (الحروف/الارقام/العلامات) AscW ، وانا لا استغني عن هذه الصورة المرفقة لعملي ، الحرف Chr ، ومقابله رقمه Dec : . وبالنسبة للحروف العربية ، هذا رابطها : https://sites.psu.edu/symbolcodes/languages/mideast/arabic/arabicchart/ او https://www.ssec.wisc.edu/~tomw/java/unicode.html#x0600 وقد قمت باخذ البيانات من الموقع ورتبتها في صفحة واحد : فمثلا اول حروف اسم ابراهيم : ا = 1575 ، ب = 1576 ، ر = 1585 ، بمعنى AscW(ا) = 1575 , AscW(ب) = 1576 , AscW(ر) = 1585 والعكس يكون ChrW(1575) = ا , ChrW(1576) = ب , ChrW(1585) = ر . للحصول على الاسم ، نريد ان يكون لدينا شرط القطع بعد الاسم وقبل بداية الرقم (اي في المنطقة 1) ، للحصول على التسلسل ، نريد ان يكون لدينا شرط القطع بعد التسلسل وقبل بداية الاسم التالي (اي في المنطقة 2) ، لمعرفة شرط القطع يجب علينا ان نحلل البيانات التي يراها الكمبيوتر ، وذلك بتحويل الحروف/الارقام/العلامات الى AscW ، هذا الكود يقوم بهذه العملية: Public Function Split_Names() Dim rst As DAO.Recordset Dim x() As String Dim i As Long Dim a As String Set rst = CurrentDb.OpenRecordset("Select * From MyTxt_from_pdf") Do Until rst.EOF For i = 1 To Len(rst!Field1) a = Mid(rst!Field1, i, 1) 'الحروف/الارقام/العلامات a = a & "(" & AscW(a) & ") " 'رقمها AscW Debug.Print a Next i Loop rst.Close: Set rst = Nothing End Function ونناديه من نافذة الكود هكذا (يجب ان يكون الكيبور باللغة الانجليزة عند كتابة علامة الاستفهام) : . ونرى ان النتيجة للسجل الاول فقط : . وبعد التدقيق ، نلاحظ ان في نهاية الارقام نرى ان AscW التالية متكررة 8236 ثم 8236 ثم 32 ثم 32 ، وبذلك يمكننا استعمال هذه كشرط القطع بعد الاسم ا(1575) ق(1602) ل(1604) ح(1581) ا(1575) د(1583) م(1605) ح(1581) ي(1610) ا(1575) م(1605) و(1608) د(1583) د(1583) س(1587) ه(1607) ?(8236) ?(8236) ?(8236) -32 -32 -32 -32 -32 -32 . بعد الرقم 3(1635) 2(1634) ?(8236) ?(8236) ?(8236) ?(8236) -32 -32 -32 -32 . وعليه نستعمل هذا الكود ، ونرى نتيجته (للسجل الاول) : Do Until rst.EOF x = Split(rst!Field1, ChrW(8236) & ChrW(8236) & ChrW(32) & ChrW(32)) 'Name + ID For i = LBound(x) To UBound(x) Debug.Print x(i) Next i rst.MoveNext Loop ونتيجته ?ابراهيم احمد يحيى احمد? ??3 ?ابتهاج سامح نسيم اقلديوس? ??2 ?ابتسام محمد عبدا حماده? ??1?? . والآن خلينا نفكك الاسم من الرقم : Do Until rst.EOF x = Split(rst!Field1, ChrW(8236) & ChrW(8236) & ChrW(32) & ChrW(32)) 'Name + ID For i = LBound(x) To UBound(x) 'Debug.Print x(i) x2 = Split(x(i), ChrW(8236) & ChrW(32) & ChrW(32)) For j = LBound(x2) To UBound(x2) Debug.Print x2(j) Next j Next i rst.MoveNext Loop والنتيجة ?ابراهيم احمد يحيى احمد ??3 ?ابتهاج سامح نسيم اقلديوس ??2 ?ابتسام محمد عبدا حماده ??1?? . ونلاحظ من القائمة اعلاه ، ان علامات الاستفهام ارقامها ?(8235) ?(8234) ?(8236) . الخطوة الاخيرة هي تنظيف النتيجة من علامات الاستفهام هذه عن طريق الامر Replace ، والتخلص من المسافة الزائدة قبل وبعد النتيجة عن طريق الامر Trim ، وبعدها نريد ان نحفظ الاسم في اول حقل ، والرقم في الحقل الثاني: LBound دائما تساوي صفر Do Until rst.EOF x = Split(rst!Field1, ChrW(8236) & ChrW(8236) & ChrW(32) & ChrW(32)) 'Name + ID For i = LBound(x) To UBound(x) 'Debug.Print x(i) x2 = Split(x(i), ChrW(8236) & ChrW(32) & ChrW(32)) For j = LBound(x2) To UBound(x2) 'Debug.Print x2(j) a = Replace(x2(j), ChrW(8234), "") a = Replace(a, ChrW(8235), "") a = Replace(a, ChrW(8236), "") a = Trim(a) 'If j / 2 = Int(j / 2) Then If j = 0 Then 'even Debug.Print "Name: ", a Else 'odd Debug.Print "ID: " & a End If 'Debug.Print a Next j Next i rst.MoveNext Loop والنتيجة Name: ابراهيم احمد يحيى احمد ID: 3 Name: ابتهاج سامح نسيم اقلديوس ID: 2 Name: ابتسام محمد عبدا حماده ID: 1 Name: احمد السيد على محمد ID: 6 Name: ابراهيم كمال ابراهيم محمد ID: 5 Name: ابراهيم سمير عياد عطاا ID: 4 Name: احمد حسن احمد رسلن ID: 9 Name: احمد حجازى على محمد ID: 8 Name: احمد السيد محمد عبدالرحمن ID: 7 . -------------------------------------------------------- وفي سياق هذا الموضوع ، كان عندي مشروع القرآن الكريم ، وحفظه في قاعدة البيانات بعدة طرق: كل صفحة عبارة عن سجل ، وفي جدول آخر ، كل سطر في سجل ، وفي جدول آخر ، كل آية في سجل وقمت بتنزيل القرآن الكريم من مجمع الملك فهد لطباعة المصحف الشريف : https://fonts.qurancomplex.gov.sa/wp02/حفص والمرفق يحتوي على الخط العثماني ، والذي تم عمله في المجمع ، ولذا فهو يحتوي على حروف/ارقام/علامات AscW تختلف عن غيرها من الخطوط ، والطريقة الوحيدة لتفكيك الاسطر كانت بإتباع خطوات شبيهه بالخطوات اعلاه 🙂 جعفر

حسب فهمى لطلبك تم دمج الامرين مع بعض بالصورة الثالتة __Daily order - نسخة.xlsm

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

وعليكم السلام-يمكنك استخدام هذه المعادلة لجمع الأرقام الموجبة =SUMPRODUCT(--($A$2:$A$1500>-1),$A$2:$A$1500) وهذه المعادلة لجمع الأرقام السالبة =-SUMPRODUCT(--($A$2:$A$1500<0),$A$2:$A$1500) جمع المبلغ بالسالب1.xlsx

السلام عليكم و رحمة الله و بركاته بسم الله الرحمن الرحيم و الحمد لله رب العاليمن و الصلاة و السلام على سيد المرسلين نبينا محمد ( صلى الله عليه و سلم ) الحمد لله الذي هدانا لهذا و ما كنا لنهتدي لو لا ان هدانا الله اما بعد اخواني الكرام جميعنا يفكر بكيفية حماية برنامجه المصنوع بواسطة الاكسسز و تعددت الطرق منها الحماية بزراعة ملف نصي و الحماية عن طريق رقم الهارد إلخ........ وطبعا المعرف ان افضل طريقة للحماية هي عن طريق الدنكل ولكن الدنكل غالي الثمن اذا كان لابد من ايجاد طريقة للحماية ولكن بسعر رخيص واقرب شيئ للدنكل هو الفلاش ميموري ولكن كيف ستطبق الحماية الطرق التي انتشرت للحماية عن طريق الفلاش ميموري كانت تستخرج الرقم التسلسي للفلاش ميموري ولكن هناك مشكلة ان هذا الرقم يتغير عند اجراء تهيئة للفلاش ( فورمات ) اذا فهذه الطريقة ضعيفة :wallbash: ولكن ماذا اذا حصلت على الرقم التسلسي الاصلي الذي لا يتغير ابدا :smile: عندها لن يتائر برنامجك حتى عند عمل فورمات للفلاشة و سيبقى محميا و قابل للاستخدام من قبل الشخص الذي يملك الفلاش ميموري حصرا اترككم مع المرفقات و ارجو ابداء الرأي حول الموضوع ملاحظة البرنامج ليس مجاني انما مأجور و الأجرة هي الدعاء للاستاذ الكبير نارت لبزو ( ابو آدم ) استخراج رقم الفلاش ميموري 4.rar

السلام عليكم ورحمة الله وبركاته 📜برنامج المخزون والفواتير الشامل الإصدار الرابع 2020 البرنامج هو تحديث للاصدارات السابقة من نفس البرنامج اولا وقبل كل شيئ اعتذر عن التأخير فى اطلاق هذا الاصدار نظرا لانشغالي الدائم وظروف خارجه عن الارادة. كما هو معروف عن برنامج المخزون و الفواتير الشامل: واجهة تطبيقية كاملة علي الاكسيل يصلح لكافة اغراض المبيعات و المشتريات وذمم عملاء وموردين و حساب المصروفات مع ميزانية عامه توضح الربح و الخساره. البرنامج مليئ بافكار جديده فى طريقة ادخال الاصناف داخل الفواتير و استدعائها و التعديل عليها.بالاضافه الي طرق جديده فى تصميم الفاتورة كما يتميز البرنامج بكثرة التقارير وسهولة الحصول عليها فى اى وقت يعمل علي جميع اصدارات الاكسيل بنواتين 32 أو 64 بت ويفضل دائما الاصدارات الاحدث من الاكسيل اوفيس 2019 و 365 البرنامج مجاني بنسبة 100 % للاستخدام الشخصي ولا يوجد به تاريخ انتهاء. وتستطيع استخدامه بامان تام.ويمنع بيع البرنامج او اي ربح تجاري بدون الرجوع الي المالك الاصلي.و الله الشاهد علي ذلك. تم تصميم البرنامج بمواصفات خاصه ويعمل للشركات الصغيره الي متوسطة الحجم او للمشاريع الخاصه .وهو فى الاصل برنامج تجارى ولكنى اقدمه هنا للمنتدى وللأخوة الاعضاء بصورة مجانية. تم اطلاق الاصدار الاول من هذا البرنامج عام 2012.وكل ما يلزم هو وجود نسخة اكسيل علي جهازك.وسيفي بالغرض تماما. هذا هو اخر اصدار للبرنامج علي اكسيل و الاصدار الخامس و لمزيد من التحسينات الكبيره سوف يتم تطويره إن شاء الله بلغة برمجه اخري وقاعده بيانات اخري. الدخول الاول:اسم المستخدم "مدير" و الباسورد 123 تم ارفاق نسختين من البرنامج نسخة الاستخدام المباشر كمستخدم ويمكنك استخدامها فى عملك مباشرة. نسخة اخري للتعلم مفتوحة المصدر وتوجد بها جميع الاكواد لجميع الشاشات داخل البرنامج للتعلم او التعديل عليها كما هو الغرض الرئيسي من هذا الصرح العظيم. يمكنك الرجوع الي الاصدارات السابقة حيث يوجد شرح كامل لكيفية استخدام البرنامج لاول مرة. توجد الروابط للاصدارات السابقة و الشرح اسفل هذا الموضوع . 📑الجديد في هذا الاصدار (2020)SIS Ver.4: شاشة تصميم الفواتير و هي من الشاشات الجديدة وبها الكثير من الاكواد الجديده فى الاكسيل (علي حسب علمي) حيث تمكنك من وضع اللوجو الخاص بالمؤسسه او الشركة الخاصه بك كما يمكنك ايضا وضع بياناتك اسفل الفاتورة كرقم التليقون و العنوان و ...... التحكم الكامل في بعض القيم و ظهورها داخل الفاتورة كرصيد العميل. شاشة اختيار عملة الدولة ووضع الضريبه او القيمه المضافه تمكنك هذه الشاشه من اختيار العمله علي حسب الدوله التي تعمل فيها. كما تمكنك من ضبط قيمة الضريبه او القيمه المضافه لفواتيرك شاشة ضبط صلاحيات المستخدمين بعد اضافة مستخدم جديد للبرنامج تستطيع ضبط صلاحيات المستخدم من الوصول الي جميع شاشات البرنامج شاشة حذف البيانات الغير مستخدمة بكل سهولة تستطيع حذف العملاء و الموردين او الاصناف الغير مستخدمة داخل البرنامج. شاشة الحركة المالية السريعة تستطيع ادخال سند صرف موردين او سند عميل بضغطة زر واحده. شاشة الفواتير الكثير من التحسينات تم ادارجها داخل شاشة الفواتير فاتورة المشتريات . انت من يقوم بوضع رقم الفاتورة الخاصه من المورد.بدلا من وضعها اتوماتيكيا كالاصدار السابق. اضافة خصم اجمالي علي الفاتورة. يتم تحديد الخصم كنسبه مئويه او خصم مبلغ مقطوع. اضافة الضريبه علي الفاتورة ويمكن تحديد قيمتها يدويا او تثبيتها من خلال شاشة البيانات الجديده وضبط الضريبه او القيمه المضافه علي حسب الدولة. مبيعات نقدي: فى حالة اختيار هذا النوع من الفواتير يتم ادراج سند قبض مباشره الي حساب العميل مع حفظ الفاتورة لانها مبيعات نقدية. ظهور رصيد العميل الحالي داخل الفاتورة. و التحكم في ظهوره من خلال شاشة تصميم الفاتورة. زر لسداد كامل الفاتورة مباشرة وادراج سند قبض او سند صرف داخل حساب العميل/المورد سند بالمبلغ المدفوع داخل الفاتورة وتسوية حساب العميل او المورد. شاشة الحركات المالية ادراج الكثير من الحركات المالية داخل سند الصرف. شاشة جديده لحساب رواتب وجميع الحسابات للموظفين العاملين فى المؤسسة او الشركة يوجد الكثير من الاضافات و التحسينات علي كل الشاشات والتقارير داخل البرنامج . تستطيع اكتشاف المزيد و المزيد اثناء استخدام البرنامج. التعامل مع رصيد اول المده (كميات الاصناف- حسابات العملاء/الموردين) تم الاستغناء عن شاشة اكواد البيانات والجرد فى هذا الاصدار وكانت تستخدم لوضع رصيد اول المده للاصناف. وعوضا عن ذلك ولحساب المخزون بطريقه منظمه يجب ان يتم وضع كميات اول المده لجميع الاصناف من خلال فاتورة مشتريات باسعار شراء محدده حتي يتم ادراجها وحسابها بطريقه دقيقه.وايضا فى حالة رصيد سابق للعملاء والموردين يجب ان يتم ادخاله من خلال شاشة الحركات الماليه( حركة ماليه رصيد اول مده او ترحيل لحساب عميل/مورد) طباعة الباركود لا تزال غير مفعله ايضا فى هذا الاصدار. 👁️‍🗨️شرح كيفية استخدام البرنامج وادخال البيانات من الاصدارت السابقة:(برجاء مراجعة الروابط التالية) شرح برنامج المخزون و الفواتير الشامل(مشاركة داخل المنتدى) استخدام البرنامج لاول مره من الاصدار الثالث شرح برنامج المخزون و الفواتير الشامل( ملف تنفيذى... 6MB رابط خارجى على موقع ميديا فاير) 🏷️تحميل البرنامج: النسخة الاولي SIS 4.566EO : هى نسخة المستخدم النهائي مجانيه 100 % لاعضاء المنتدي الكرام وليس لها تاريخ انتهاء وكما ذكر سابقا هي للاستخدام الشخصي فقط. 💳SIS 4.566EO.rar النسخة الثانيه SIS 4 Learning : هي نسخة للمطورين و الباحثين عن التعلم وهي نسخة مفتوحة المصدر تحتوي علي جميع اكواد الشاشات داخل البرنامج. 🧼SIS4(Learning).rar إن شاء الله سوف اقوم بالرد علي استفسارات اعضائنا الكرام عندما يتوفر لي الوقت و اعتذر مقدما عن اي تاخير نظرا لانشغالي الدائم. اخيرا أحب انا أشكر جميع مشرفي و اعضاء هذا الصرح العظيم. واتمني من الله ان يكون هذا العمل خالصا لوجه الله سبحانه و تعالي و انا اكون قد قدمت تجربه جيده لهذا النوع من البرامج علي الاكسيل وان ينفع به جميع اعضاء المنتدي الكرام

بس الظاهر انك فهمت السؤال صح ، بينما انا قرأت رأس الموضوع ، وما لاحظت الملاحظة إلا بعد ان وضعت ملاحظتي !! على العموم ، هذه طريقتي ، لحدث الزر (طبعا بالاضافة الى الكود في مشاركتي السابقة) : Private Sub T_m_Click() On Error GoTo err_T_m_Click If Len(Me.FROM & "") = 0 Then MsgBox "رجاء تعبئة التاريخ من" Me.FROM.SetFocus ElseIf Len(Me.TO & "") = 0 Then MsgBox "رجاء تعبئة التاريخ الى" Me.TO.SetFocus ElseIf Len(Me.PN & "") = 0 Then MsgBox "رجاء اختيار اسم المشروع" Me.PN.SetFocus Me.PN.Dropdown Else DoCmd.OpenReport "All_Proj", acViewPreview End If Exit_T_m_Click: Exit Sub err_T_m_Click: If Err.Number = 2501 Then 'No data Else MsgBox Err.Number & vbCrLf & Err.Description End If Resume Exit_T_m_Click End Sub . جعفر 1253.APE (1).accdb.zip

وعليكم السلام 🙂 في التقرير ، في حدث No Data ، اكتب هذا الكود (طبعا يمكنك حذف سطر الرسالة، ولكني افضل ان يعرف المستخدم ان البرنامج يعمل وان التقرير فارغ) : Private Sub Report_NoData(Cancel As Integer) MsgBox "لا توجد بيانات" Cancel = True End Sub جعفر

تفضل لعلة المطلوب APE.accdb

استخدم هذا الكود Dim fpathz As Variant Dim fil As String With Application.FileDialog(3) .Title = "Choose File" .Filters.Clear .Filters.Clear .Filters.Add "All Files", "*.*" .AllowMultiSelect = False .InitialFileName = "" If .Show = -1 Then fpathz = .SelectedItems(1) End If End With 'DoCmd.SetWarnings False DoCmd.RunSQL "INSERT INTO tb_redy_rateb ( id_imp, tmonth, tyer, school, tnam, national_iD, old_asis, new_asis, elawa14, elawa15, edafya, egtemaya, hafz25, adaaa, badlteatcher, kader, ekama, shamel, add_nesab1, add_nesab2, add_nesab3, add_nesab4, masthkak, mastktaa, safy ) IN '" & fpathz & "' SELECT * " & vbCrLf & _ "FROM tb_redy_rateb;" 'DoCmd.SetWarnings True

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

يمكنك استخدام هذا الكود اخى Sub towmacro() Application.ScreenUpdating = False PrintAllFirstPage Export_PDF_in_OneAll Application.ScreenUpdating = True MsgBox "Done" End Sub

وعليكم السلام ورحمة الله وبركاته نفضل اخي الكريم وجدت لك هذا المثال ويمكن تطويره اكثر بما يناسبك za-AccessAndPowerPoint.rar تحياتي

وعليكم السلام ورجمة الله وبركاته تفضل اخي الكريم هذا الكود يعمل على نواة 32 و 64 لاستعراض الملفات Dim fpathz As Variant With Application.FileDialog(3) .Title = "Choose File" .Filters.Clear .Filters.Clear .Filters.add "All Files", "*.*" .AllowMultiSelect = False .InitialFileName = "" If .Show = -1 Then fpathz = .SelectedItems(1) End If End With ولتحديد مسار قاعدو البيانات Application.CurrentProject.Path تحياتي

للأسف لا يوجد حدث عند إخفاء أو إظهار الأعمدة أو الصفوف في الشيت ولكن يمكن التحايل على ذلك بوضع كود الحساب في حدث عند تغيير التحديد بحيث أنه بعد الإخفاء أو الإظهار يكتفى بوضع المؤشر في أي مكان في الشيت لتقوم الدالة بالحساب Private Sub Worksheet_SelectionChange(ByVal Target As Range) ActiveSheet.Calculate End Sub وطبعا يتم لصق هذا الكود في شاشة الأكواد الخاصة بالشيت الذي به معادلة جميع الأعمدة المرئية فقط بالضغط دبل كلك على اسم الشيت

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

شكرا جزيلا استاذنا الفاضل أستاذ /علي هذا هو المطلوب فعلا وجزاكم الله عنا كل خير وبارك فيكم

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

السلام عليكم تم تم ( يحتاج الى بعض التنسيقات ) من نموذج تسجيل المشتركين تم Up-MILAN.rar تحياتي

فعلا subtotal لا تعمل مع الأعمدة لكن يمكنك استعمال هذه الدالة Function sum_vis_cols(rng As Range) As Double Dim mysum As Double, c As Range Application.Volatile For Each c In rng mysum = mysum + IIf(c.EntireColumn.Hidden <> True, c.Value, 0) Next sum_vis_cols = mysum End Function وطريقة استعمالها =sum_vis_cols(E1:CX1) بالتوفيق

جرب هذا اكود ActiveSheet.PageSetup.RightFooter = Range("n5").Value & chr(10) & Range("o5").Value حيث chr(10) تعني سطر جديد وهو يساوي الضغط على alt+enter داخل الخلية

تفضل اخي التعديل على الملف الأخ @ةm7md83 اختيار من الجدول للتقرير.rar

وعليكم السلام اخى @عزالدين المنصوري اعتذر عن التاخير فالرد بالنسبه لتخزين الوقت فهذا يتم فعلا عند فتح النموذج فالمتغير nowLogin اتفضل شوف التعديل وان شاء الله يشاركنا اخواننا واساتذتنا جزاهم الله خيرا بالتوفيق حساب الوقت_2.accdb

في حال كان عدد الصفوف كبيراً (اكثر من 10 ) وقتها يجب ان نعين الكثير من المتغيرات S1/S2/....... /S20 و أرى ان هذا الأمر يأخذ كود طويل جداَ لذلك اقترح هذا الكود الذي يحدد اوتوماتيكياً عدد الصفوف و يحمعها في Array Option Explicit Sub Free_summation_1() Dim M As Worksheet Dim M_index Dim t%, k% Dim lr% Dim Arr() lr = Sheets("Jan").Cells(Rows.Count, 2).End(3).Row For k = 2 To lr ReDim Preserve Arr(k - 2) Arr(k - 2) = 0 Next Set M = Sheets("Month") M_index = M.Index If M_index = 1 Then Exit Sub If M_index > 12 Then M_index = 13 For t = 1 To M_index - 1 For k = LBound(Arr) To UBound(Arr) Arr(k) = Arr(k) + _ IIf(IsNumeric(Sheets(t).Range("B" & k + 2)), _ Sheets(t).Range("B" & k + 2), 0) Next k Next t M.Range("B2").Resize(UBound(Arr) + 1) = _ Application.Transpose(Arr) End Sub ما أقصده في هذا الملف Moustafa_extra.xlsm

اخواني الكرام بعد التوكل على الله ثم الاستشارة وحسب رغبة بعض الاخوة نبداء على بركة الله هذه الدورة شروط الدورة: تقتصر الدورة على شرح الفيجول بيسك للتطبيقات VBA ولا علاقة للمعادلات بهذه الدورة لذا نرجو ان يقتصر السؤال والاستفسار حول الاكواد فقط. عدم إضافة عبارة الشكر (نشكر الجميع على تقدير الجهود) حتى لا يحتاج الموضوع الى تنقيح فإن أعجبك شرح أو رد يمكنك تقييمه من خيار أعجبني شكراً. ان يكون موعد الاستفسارات حول الجزء المطروح للشرح خلال 24 ساعة فقط ويتم الانتقال الى جزء أخر لتعميم الفائدة. سيكون الشرح بشقين كتابي ومرئي. على الاساتذة الذين يشاركون في الشرح اخذ الشرط الثالث بالاعتبار (مشكورين). * سيتم حذف أي مشاركة لا يتم التقيد فيها بالشروط. == تم نقل جميع مشاركات النقاش الى هنا =============================== دروس الدورة ============================= الدرس الاول1 الدرس الاول2 الدرس الثاني الدرس الثالث الدرس الرابع 1 الدرس الرابع 2 الدرس الرابع 3 اساسيات لغة VBA كلغة برمجة (نظري) الفصل الثالث ج1 الفصل الثالث ج2 اسئلة الدورة (الجزء الاول)

السلام عليكم 🙂 الخطوة الاولى وبالتفصيل هي تصفية البيانات : . وهذا الكود كاملا لبرنامجك ، وحفظ البيانات في الجدول: Public Function Split_Names() Dim rst, rst2 As DAO.Recordset Dim x() As String: Dim x2() As String Dim i, j As Long Dim a As String Set rst = CurrentDb.OpenRecordset("Select * From MyTxt_from_pdf") Set rst2 = CurrentDb.OpenRecordset("Select * From tbl_Names") ' Do Until rst.EOF ' For i = 1 To Len(rst!Field1) ' a = Mid(rst!Field1, i, 1) 'الحروف/الارقام/العلامات ' a = a & "(" & AscW(a) & ") " 'رقمها AscW ' Debug.Print a ' Next i ' loop Do Until rst.EOF x = Split(rst!Field1, ChrW(8236) & ChrW(8236) & ChrW(32) & ChrW(32)) 'Name + ID For i = LBound(x) To UBound(x) 'Debug.Print x(i) x2 = Split(x(i), ChrW(8236) & ChrW(32) & ChrW(32)) For j = LBound(x2) To UBound(x2) 'Debug.Print x2(j) a = Replace(x2(j), ChrW(8234), "") a = Replace(a, ChrW(8235), "") a = Replace(a, ChrW(8236), "") a = Trim(a) 'If j / 2 = Int(j / 2) Then If j = 0 Then 'even rst2.AddNew rst2!iName = a Else 'odd 'the numbers in Arabic are different (text) than those in English, so we have to get the value of the normal number '0=1632, 1=1633, 2=1634, 3=1635, 4=1636, 5=1637, 6=1638, 7=1639, 8=1640, 9=1641 'Arabic Numbers '0=48, 1=49, 2=50, 3=51, 4=52, 5=53, 6=54, 7=55, 8=56, 9=57 'ascii 'instead of using long if statements, lets make a formula: 0=48=1632-1584 rst2!iID = ChrW(AscW(a) - 1584) rst2.Update End If 'Debug.Print a Next j Next i rst.MoveNext Loop rst.Close: Set rst = Nothing End Function . اما البحث عن مشكلة مع اللغة العربية في ال او لفظ الجلالة ، فانا عملت وحدة نمطية تقوم بتغيير الاسم ، ولكن يتوجب عليك اضافة بقية الاسماء المقطوعة في الوحدة النمطية ، في المتغير arr : Public Function Reconstruct_Allah_Name(N As String) As String Dim arr() Dim x arr = Array("عطاا", "عبدا") For Each x In arr If InStr(N, x & " ") > 0 Then 'there is a space after the missing name Reconstruct_Allah_Name = Replace(N, x, x & "لله") Exit Function ElseIf InStr(N, x) + Len(x) - 1 = Len(N) Then 'the missing name is at the end of the line Reconstruct_Allah_Name = Replace(N, x, x & "لله") Exit Function Else Reconstruct_Allah_Name = N End If Next x End Function . ثم يقوم استعلام التحديث qry_Reconstruct_Allah_Name بمناداة الوحدة النمطية اعلاه ، وتغيير الكلمات 🙂 والعمل يتم بالنقر على الزر المشار اليه في الصورة ادناه ، في النموذج Form1 : . جعفر 1251.db1.mdb.zip