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

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

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

في الاساس برنامج نقطة بيع الذي عملته لمبيعات التجزئة لمتاجر وانشطة صغيرة ندخل في الموضوع اغلب الاصناف يتم توريدها بالكرتون ويتم ترميزها برمز الكرتون لمبيعات كرتون وترمز بالعلبة للبيع المفرد وهو الاكثر مبيعا الترميز فقط للاصناف الجديدة التي لم يسبق ترميزها الاصناف بالكرتون عند بيعها بالكرتون لا توجد هنا اي مشكلة اما اذا اردنا ان نفتح كرتون لبيع مفرد او تلف لبعض العبوات في الكرتون او تلف التغليف الخارجي للكرتون فلدينا شاشة تفريد الاصناف يتم فيها اختيار الصنف ( الكرتون ) والصنف المفرد ثم النقر على امر تفريد فيتم زيادة كمية الصنف علبه او وحدة بعدد العلب الموجودة في الكرتون اي ان اضافة الاصناف المفردة تكون لدينا من خلال فاتورة المشتريات مباشرة او من خلال شاشة تفريد صنف اما الصنف كرتون فيكون فقط من شاشة فاتورة مشتريات اي صنف يتم تفريدة يتم نقل تكاليفة الى صنف مفرد وتنقص كميتة من رمز كرتون مثلا لدينا 10 كراتين ماء صفا 200 مل تم تفريد كرتون واحد يكون المتبقي 9 كراتين وفي خانة ملاحظات كرتون 1 تم التفريد وتزيد كمية علبة ماء صفا بمقدار 48 علبة على العموم البرنامج في مرحلة التجربة في بيئة عمل فعلية وهناك العديد من الملاحظات التي لم يتسع وقتي لمعالجتها بسبب الاوضاع الحالية والمزاج الغير مواتي وتقبل اطيب تحياتي

جرب هذا الماكرو Option Explicit Sub salim_code() Dim s As Worksheet Dim La%, I%, Ro1, Ro2 Dim F_rg As Range, Source_rg As Range Dim My_number Set s = Sheets("Sheet1") La = s.Cells(Rows.Count, 2).End(3).Row Set Source_rg = s.Range("B4:B" & La) Source_rg.Font.ColorIndex = vbBlack My_number = Abs(s.Range("F3")) For I = 5 To La If IsNumeric(Cells(I, 2)) Then _ s.Cells(I, 2) = Abs(s.Cells(I, 2)) Next For I = 4 To La If s.Cells(I, 2) = My_number Then s.Cells(I, 2) = -s.Cells(I, 2) s.Cells(I, 2).Font.ColorIndex = 3 End If Next I End Sub الملف مرفق Saerch_Please.xlsm

أهلا بك @ابو البشر بالنسبة للرقم (1): المنهج GetRows يعيد عدد من صفوف بيانات الجدول المشار إليه في المتغير الغرضي XLRS. والرقم بين القوسين يبين عدد الصفوف المطلوب إعادتها.. المنهج GetRows يعيد مصفوفة بيانات من حدين؛ الحد الأول يمثل رقم عمود البيانات (الحقل) في الجدول والثاني يمثل رقم الصف البيانات (السجل).. هذه الحدود يبدأ ترقيمها بالرقم 0 يجب اسناد المنهج GetRows إلى متغير مصفوفة بيانات عامة غير معينة الحدود.. وهو هنا RCROW؛ وهو المشار إليه بالرقم (2). وكمثال (0,0)RCROW يعيد قيمة العمود الأول من الصف الأول في جدول البيانات. بالنسبة للرقم (3) :عند تجهال أسماء أعمدة البيانات المستوردة من أكسل يقوم أكسس بوضع أسماء مزيفة تبدأ بـ (F1)؛ و (F) اختصار كلمة Field و(1) رقم عمود البيانات في أكسس.. إذا كانت ورقة البيانات في أكسل تحتوي على أسماء للأعمدة فيمكن تغيير ذلك من خصائص استيراد البيانات؛ إما على مستوى مصنف البيانات أو على مستوى ورقة بيانات محددة... بالنسبة للرقم (4): يمكن الاستغناء عن المحدد، أو توسيع نطاقه.. لكن لا يمكن استخدام نطاقات متعددة في المجال الواحد.. أرجو أن يكون هذا التفسير واضحاً ومفهوماً ..

الحل الاتصال بمبرمج القاعدة للحصول على كلمة المرور

تسلم عينيك اخي احمد نحن مديونون لك هههههه خلك شاهد لو مادفع اخي ازهر 😃

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

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

هذة الصور من نسخة البيتا وليست النهائية ونعم في النسخة النهائية توجد عبارة دفع جزئي ولكن للاسف هذا المشروع معطل لوجود خلاف مع المستفيد من البرنامج ولم يتم حل الخلاف 😭

من الامور التي اراها مهمة في اي برنامج اقساط ان يكون لدينا حقل للمبلغ المدفوع مثل لو لم يتم العميل من دفع كامل قيمة القسط وبالتالي يستطيع دفع اي مبلغ ويظهر لدينا المبلغ المتبقي من قيمة القسط شاهد القسط رقم 4

السلام عليكم جزا الله أستاذنا @أحمد الفلاحجى عنا خيرا ولكن ما أحببت أن أخلف وعدي فهذا ما توصلت اليه لعلها تكون طريقة اخري تصلح لمبتدئ مثلي Prog3.rar

الكود الذي اعطيتك ، والذي اعطاك ابو تراب ، يفتح البرنامج الآخر ولا ينتظر ان يُنهي البرنامج عمله ، وينتقل الطود للسطر التالي ، ولكن وفي بعض الاوقات ، تريد ان تفتح برنامج (او بمعنى اصح ، تريد ان تفتح برنامج ، وتكون قد ارسلت اليه المتغيرات المطلوبة مثل عمل QR Code مثلا) ، وتريد VBE ينتظر انتهاء البرنامج من عمله ، لهذا السبب نستعمل كود مثل Shell_n_Wait : https://github.com/xxdoc/vb6-Shell-Wait/blob/master/Shell %26 Wait v2/modShellWait.bas بنفس طريقة استعمال Shell او ExecuteFile اللي عرضه اخي ابو تراب ، شوف سطر عمله : جعفر

هلا اخي وهذه طريقة اخرى...استدعي الدالة ExecuteFile مصدر الكود من الموقع MS Access VBA – Open a File Option Compare Database Option Explicit 'Source: http://www.pacificdb.com.au/MVP/Code/ExeFile.htm Public Const SW_HIDE = 0 Public Const SW_MINIMIZE = 6 Public Const SW_RESTORE = 9 Public Const SW_SHOW = 5 Public Const SW_SHOWMAXIMIZED = 3 Public Const SW_SHOWMINIMIZED = 2 Public Const SW_SHOWMINNOACTIVE = 7 Public Const SW_SHOWNA = 8 Public Const SW_SHOWNOACTIVATE = 4 Public Const SW_SHOWNORMAL = 1 Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _ (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _ ByVal lpParameters As String, ByVal lpDirectory As String, _ ByVal nShowCmd As Long) As Long Public Sub ExecuteFile(sFileName As String, Optional ByVal sAction As String = "Open") Dim vReturn As Long 'sAction can be either "Open" or "Print". If ShellExecute(Access.hWndAccessApp, sAction, sFileName, vbNullString, "", SW_SHOWNORMAL) < 33 Then DoCmd.Beep MsgBox "File not found." End If End Sub

وعليكم السلام 🙂 اذا كان strFile هو اسم الملف + مساره ، فتستطيع فتحه هكذا: application.followhyperlink strFile جعفر

لأنك ارفقت ملف وورد .. لا يمكن العمل على الملف أاضف هذا الكود الى النطاق الذي تريد وضعت لك زرين . الاول لحجم الخط و الثاني لششكل التاريخ حسب طلبك يمكنك وضعهم في زر واحد . او اضافتهم الى كودك. فقط حتى تفهم الكود بالنسبة لعرض العمود هدا الكود Columns("A:B").Select Selection.EntireColumn.AutoFit للاحتواء التلقائي لمضمون النطاق أو Sub Column_Width() Columns("D:E").ColumnWidth = 10 End Sub ضع العرض كما تشاء font -date format.xlsm

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

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

وعليكم السلام اخى واستاذى العزيز @أبو عبدالله الحلوانى كل عام وانت بخير منور الموقع مشاركه مع اخى الفاضل @ابو تراب جزاه الله خيرا لعل هذا الشرح يفيدك ايضا جزاه الله خيرا استاذ محمد فؤاد http://arabteam2000-forum.com/index.php?/topic/125583-كيف-تبني-برنامج-مخازن-ومبيعات-بطريقة-صحيحة-؟؟/ تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق

السلام عليكم انا مع ما تفضل به الاستاذ خالد ويسرني ان اشارك بشيء مما مررت به : المحلات التجارية اما ان تمتهن بيع الجملة وإما التفريد وهي ما يهمنا هنا ، وقد يوجد من يجمع بينهما لنضرب مثلا : محلات بيع الحلويات ، ولنأخذ نوع من الحلويات وهي اصابع الشيكولا ، فهي تتوفر بالكرتون الذي يحتوي على 12 علبة وفي كل علبة 24 اصبعا . فمحلات الجملة تبيع بالكرتون والعلبة .. وهنا يكون تعاملنا مع الصنف الأصغر ومحلات التجزئة تبيع بالعلبة والحبة .. وهنا سيكون تعاملنا مع الصنف الأصغر .... في محلات الجملة حين نمرر قارىء الباركود على باركود الكرتون مباع سوف يسجل 12 علبة في العدد ، ومثلها في المشتريات عند الادخال للمستودع وقس على ذلك محلات التجزئة : عند ادخال العلبة سوف يسجل 24 اصبع شيكولا ,, وعند ادخال الاصبع سوف يسجل اصبعا واحدا الخلاصة : يجب اعتماد حقل واحد يحتوي على وحدة معينة من الصنف ، هي التي يتم التعامل معها .

وده شرح فيديو لعله يفيد بشئ

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

هدية مقبولة كرتون مناديل يحتوي على اربعة وحدات مغلفة كل مغلف يحتوي على 6 علب يمكن تفريد الكرتون مغلفات وبيعها هكذا او تفريدها علب ليكون عدد العلب 24 علبة او حتى تفريغ مغلف واحد ليكون لدينا 3 مغلفات وست علب والترميز امر سهل وفقا للصورة اعلاه

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

اتفق ان الترجمة الطبيعية هو "منظمة"، و هو الترجمة المقبولة كذلك. و قد درج البعض استخدام المصطلح لوصف "مؤسسة" كذلك، في حين أن كلمة مؤسسة تعتبر ترجمة أفضل لكلمة institution.

اليكم فيديو شرح شيت الصف الاول الابتدائى الحديث رابط الفيديو المعدل https://youtu.be/Fg8jDccnZsE والبرنامج نفسه فى المرفقات الصف الاول الابتدائى.rar

بالتوفيق استاذي @kha9009lid الاستاذ @أحمد الفلاجي اسمك موجود في البرنامج عليك اقساط كثيرة اللة يعينك

تم التعديل على الكود ليعمل على طريقة (Find) Option Explicit Sub Salim_Code_With_Find_Methode() Dim S As Worksheet Dim La%, first_address Dim find_range As Range, Source_rg As Range Dim My_cel As Range, Opt_rg As Range 'Optional range Set S = Sheets("Sheet1") La = S.Cells(Rows.Count, 2).End(3).Row Set Source_rg = S.Range("B5:B" & La) Source_rg.Font.ColorIndex = vbBlack For Each My_cel In Source_rg My_cel = Abs(My_cel) Next With S.Range("B4:B" & La) Set find_range = .Find([f3], after:=Range("B" & La), lookat:=1) If Not find_range Is Nothing Then first_address = find_range.Address Do If Opt_rg Is Nothing Then Set Opt_rg = Range("B" & find_range.Row) Else Set Opt_rg = Union(Opt_rg, Range("B" & find_range.Row)) End If Set find_range = .FindNext(find_range) If first_address = find_range.Address Then Exit Do Loop End If End With If Not Opt_rg Is Nothing Then Opt_rg.Value = -Opt_rg.Value Opt_rg.Font.ColorIndex = 3 Else MsgBox "Your Value: " & [f3] & Chr(10) & " Is'nt Found" End If End Sub الملف مرفق Saerch_Please_Find.xlsm

جزاك الله خير استاذي @أحمد الفلاحجى للتغلب على موضوع التعديل على الاقساط بعد التنفيذ التي اشرت اليها اولا وثانيا ممكن نقوم باضافة حقلين في الجدول الاول للمبلغ الاجمالي والحقل الثاني ممكن في الجدول او غير منظم نحتاجة في بقية العمليات عند اضافة العميل يتم ادخال المبلغ الاجمالي مثلا 15000 ثم ادخال الدفعة الاولى مثلا 1000 يكون المتبقي 14000وعند اختيار عدد الاقساط يقوم البرنامج بتحديد قيمة القسط الشهري لو اخترنا عدد الاقساط 2 يكون القسط 7000 ولو كان عدد الاقساط 12 يكون القسط الشهري 1667 اي ان قيمة القسط تكون بدون تدخل منا وتحدد قيمتها بناء على المبلغ الاجمالي والدفعة المقدمة وعدد الاقساط الشهري فاذا رغب العميل في قسط اقل يجب عليه زيادة الدفعة المقدمة او زيادة عدد الاقساط وحينا لسنا بحاجة الى امر تعديل لكون البرنامج يعمل وفق اليه محددة سلفا واعذروني اليوم كلامي كثر شكل السوبيا مضروبة

جزاك الله خيرا اخى واستاذى خالد @kha9009lid بالعكس فاننى استفيد من مداخلتكم لانها توضح بعض الامور وبالفعل راحت عن دماغى جزئيه انه سيتم تعديل جميع الاقساط ومن ضمنها التى قد تم دفعها وانتقد براحتك فنحن نتعلم منكم اخى واستاذى العزيز خالد بارك الله فيك

الاستاذ @أحمد الفلاحجى تعديل جميل وملاحظتك يتم استخدام هذا الزر هذا ان قمت بادخال القيمه بالخطا وتم تنفيذ تسجيل الاقساط فعليا مهمة جدا مع ذلك لو تم تعديل قيمة القسط وكان هناك اقساط مدفوعة سيتم تعديلها ايضا وهنا تكون مشكلة اعتقد لو اضفنا حقل في استعلام التحديث حالة الدفع واضافنا معيار <>"تم الدفع" عندها سيتم تحديث الاقساط الغير مدفوعة فقط هذا اولا ثانيا فكره البرنامج تتمحور حول الدفعة المقدمة وقيمة القسط الشهري بدون اي ذكر للمبلغ المراد تقسيطة وبالتالي لو كانت الدفعة الاولى 1000 ووعدد الاقساط 12 قسط وقيمة القسط 1000 يكون الاجمالي 13000 فاذا رغب العميل في تعديل قيمة القسط الى 900 فان الاستعلام هنا يحل مشكلة التعديل ولكن الاجمالي لن يكون صحيح 900*1000+12= 11800 اختلف المبلغ اتمنى الا ينظر الى مداخلتي بانها انتقاد لعمل الاستاذ الخلوق @سيد رجب او لتعديلكم استاذي واخي احمد والله الموفق

اشكرك اخي خالد وبارك الله فيك هذا المطلوب

السلام عليكم هذه مشاركة مع استاذنا ابو تراب ملاحظة : الحل عن طريق معادلة اي لا حاجة للجدول Root210.rar

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

اسم الملف والمسار يجب ان يكون بين العلامتين "" ، هكذا : application.followhyerlink "C:\...\...\calc.exe" لجميع الاجابات اعلاه ، ومنهم shell و shell_n_wait وووو جعفر

هذه احدى الافكار Private Sub Form_BeforeUpdate(Cancel As Integer) If MsgBox("Data has been changed, would you like to save", vbOKCancel) = vbCancel Then Cancel = True Me.Undo End If End Sub

السلام عليكم مشاركة مع اخي واستاذي أحمد الفلاحجى محاولة للتقريب بطريقتين (وحدة نمطية واستعلام ارجو ان يكون طلبك Root150.rar

بعذ اذن الاخ ارائد هذا الملف My_saerch.xlsx

تفضل معادلة بحث.xlsx

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

تعديل بسيط آخر جرب ووافنا بالنتيجه الاقساط.rar

ما شاء الله عليك .. كفيت ووفيت . .

جرب هذا الملف الكود Option Explicit Sub From_sheet_to_Form() With Sheets("Salim") If .Range("N6") = vbNullString Then Exit Sub .[P8] = Evaluate("=VLOOKUP($N$6,$A$2:$J$100,2,0)") .[N8] = Evaluate("=VLOOKUP($N$6,$A$2:$J$100,3,0)") .[P10] = Evaluate("=VLOOKUP($N$6,$A$2:$J$100,4,0)") .[N10] = Evaluate("=VLOOKUP($N$6,$A$2:$J$100,5,0)") .[Q12] = Evaluate("=VLOOKUP($N$6,$A$2:$J$100,6,0)") .[O12] = Evaluate("=VLOOKUP($N$6,$A$2:$J$100,7,0)") .[M12] = Evaluate("=VLOOKUP($N$6,$A$2:$J$100,8,0)") End With End Sub '+++++++++++++++++++++++++++++++++++++++ Sub add_to_data_val() Dim arr(), m%, i%, lr% Dim s As Worksheet Set s = Sheets("Salim") lr = s.Cells(Rows.Count, 1).End(3).Row i = 2: m = 1 Do Until i = lr + 1 If Application.CountIf(s.Range("A2:A" & i), s.Range("A" & i)) = 1 Then ReDim Preserve arr(1 To m) arr(m) = s.Range("A" & i) m = m + 1 End If i = i + 1 Loop ReDim Preserve arr(1 To m) arr(m) = s.Range("N6") With s.Range("N6").Validation .Delete .Add 3, Formula1:=Join(arr, ",") End With s.Range("A" & lr + 1) = arr(UBound(arr)) s.Range("N6") = arr(UBound(arr)) End Sub '++++++++++++++++++++++++++++++++++++++++++++ Sub Form_To_sheet() Dim s As Worksheet Dim rg As Range, RO% Dim lr%, Answer As Byte Set s = Sheets("Salim") lr = s.Cells(Rows.Count, 1).End(3).Row If Application.CountIf(s.Range("A2:A" & lr), s.Range("N6")) = 0 Then Answer = MsgBox("This code dosn't exixts!.. " & Chr(10) & _ "Do you like to add it", 4) If Answer = 6 Then add_to_data_val Exit Sub End If End If Set rg = s.Range("A1:A" & lr).Find(s.[N6], lookat:=1) If rg Is Nothing Then Exit Sub RO = rg.Row With s .Range("A" & RO) = .[N6]: .Range("B" & RO) = .[P8] .Range("C" & RO) = .[N8]: .Range("D" & RO) = .[P10] .Range("E" & RO) = .[N10]: .Range("G" & RO) = .[Q12] .Range("H" & RO) = .[O12]: .Range("I" & RO) = .[M12] End With End Sub الملف مرفق Vice_versa.xlsm

السلام عليكم و رحمة الله و بركاته تفضل 1. تحقق من وجود mscomct2.ocx على جهازك ان وجدته ادهب مباشرة الى النقطة رقم 6 في أسفل االشرح ان لم تجده . 2- حمله من المرفقات الملف يعمل فقط لنسخ 32 بت للاكسل 2019-2016-2013 3- بالننسبة للونددوز 32-bit ضعه في هذا المسار C:\Windows\System32 بالننسبة للونددوز 64-bitضعه في هذا المسار C:\Windows\SysWoW64 4-الأن تسجيل الملف ادخل على قائمة إبدأ ثم Command Prompt و بالضغط على الزر الايمن اختر Run as Administrator. بالنسبة للوندوز 32 اكتب هذا الامر أو انسخه مباشرة C:\Windows\System32\regsvr32.exe mscomct2.ocx بالنسبة للوندوز 64 C:\Windows\SysWoW64\regsvr32.exe mscomct2.ocx 5-انسخ الامر و ضع المؤشر في Command Prompt ثم ااضغط الزر الايمن للفأرة . يلصق مباشرة ثم ENTER الان انتهيت من التسجيل 6-افتح اكسل ثم OPTIONS 7-الآن 8-ثم و بعد ذلك يمكنك ادرااجه من تبويب المطور أكرر فقط اوفيس 32 بت الصور من النت للأمانة و الحمد لله. MSCOMCT2.zip

بعد اذن اخي الرائد لا ضرورة لكل هذه الحلفات التكرارية (بدل التنقل داخل النطاق المطلوب نقله خلية خلية ) انسخ النطاق كاملاُ الى الخلية الهدف لاحظ هذا الكود Option Explicit Sub My_code_1() Dim CRow%, jRow%, HowMany% Dim rng As Range Dim I As Worksheet, S As Worksheet Set I = Sheets("INV"): Set S = Sheets("SLS") Set rng = Sheets("INV").Range("c14:c23") HowMany = Application.CountA(I.Range("c14").Resize(10)) CRow = S.Range("C1048576").End(xlUp).Row + 1 jRow = S.Range("J1048576").End(xlUp).Row + 1 CRow = Application.Max(jRow, CRow) I.Cells(14, "C").Resize(HowMany, 5).Copy S.Cells(CRow, "c").PasteSpecial (12) I.Range("G24:G27").Copy With S.Cells(CRow + HowMany, "J") .PasteSpecial (12), Transpose:=True .Resize(, 4).Interior.ColorIndex = 6 End With S.Cells(CRow, "H") = I.Cells(8, "D") S.Cells(CRow, "I") = I.Cells(7, "D") I.Range("C14:C23").ClearContents I.Range("D8").ClearContents Application.CutCopyMode = False End Sub الملف مرفق Salim_Book.xlsm

من عيوني Test1.xlsx

بعد اذن أستاذ احمد تفضل اخي هذا بالكود بعد كتابة الارقام اضغط على ايقونة العدسة وسيتم جلب البيانات Sub EtaEng() Dim idnum As Variant, b As Object, i As Double Sheet2.Activate idnum = Left(Range("D7").Value, 4) Set b = Sheet1.Columns("b").Find(idnum, lookat:=xlPart, LookIn:=xlValues) If Not b Is Nothing Then 'exists i = b.Row Range("D10").Value = Sheet1.Cells(i, 3) Range("D12").Value = Sheet1.Cells(i, 2) Range("D14").Value = Sheet1.Cells(i, 4) Range("D16").Value = Sheet1.Cells(i, 5) Range("H10").Value = Sheet1.Cells(i, 6) Range("H12").Value = Sheet1.Cells(i, 7) Range("H14").Value = Sheet1.Cells(i, 8) Range("H16").Value = Sheet1.Cells(i, 9) Else MsgBox "هذا الرقم غير موجود", vbExclamation End If End Sub ملاحظة : يمكنك تغيير عدد الارقام كما تشاء من خلال هذا السطر وهو مصمم لاربعة ارقام ويجب ان تكتب الارقام من اليسار الى اليمين كما ترى idnum = Left(Range("D7").Value, 4) كشف_المحتاجين_2.xlsm

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

تفضل ملف_تطبيق_الجمع_بشروط.xlsm

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