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

بسم الله الرحمن الرحيم الاخوة الزملاء فى هذا الصرح العظيم اقدم لكم الدرس الثانى من علمنى كيف اصطاد شرح مبسط عن كيفية عمل كود ترحيل من خلايا متفرقه بورقه عمل الى ورقة عمل اخرى بناء على طلب الاخ الكريم / بيف الدين حسام يريد معرفه كيفية عمل كود ترحيل من سند قبض الى شيت الخزينة كما هو موضح بالصور المطلوب ترحيل الخلايا المظلله باللون الاصفر بورقه عمل (توريد) الى ورقة عمل حركة الخزينة اولا : الضغط على ALT+F11 لفتح محرر الاكواد ثم من قائمة insert نختار مودويل جديد سيظهر لنا شاشة بيضه هنبداء بسم الله كتابة الكود Sub ترحيل() End Sub السطر الاول هو الاعلان عن بداية الكود sub يلية اسم الكود وهو ترحيل يلية () يعنى فتح قوس ثم غلقه فبمجرد كتابة السطر الاول سوف يتم ظهور السطر الثانى وهو End sub أنا عايز كل واحد يكتب الكود بنفسة مش ينسخ / من فضلك عايزك تكتب ثانيا : كتابة هذا السطر Sub ترحيل() Application.ScreenUpdating = False End Sub هذا السطر يعنى تثبيت الشاشه عند الترحيل ( يعنى عدم اهتزاز الشاشه اثناء تطبيق الكود ) ثالثا : ايه المطلوب هو ترحيل الخلايا المظلله باللون الاصفر بورقه عمل توريد الى ورقة عمل حركة الخزينة اذن الشيت اللى هتروح له البيانات هو شيت حركة الخزينة وهو اسمه حسب الملف المرفق وكما هو موضح بالصورة Sheet4 وليس حركة الخزينة ملحوظه/عند استخدم اسم شيت باى كود يفضل كتابة اسم الشيت الثابت كما هو بمحرر الاكواد لانه احتمال تغيير اسم الشيت من (حركة الخزينة) الى (قاعدة البيانات )مثلا فى هذه الحاله لا يعمل الكود نرجع للكود بتاعنا ونضيف الاتى Sub ترحيل() Application.ScreenUpdating = False With Sheet4 End With End Sub ما تم اضافته هو With Sheet4 كلمة With معناها الحرفى ( مع) أى مع الشيت Sheet4 لماذا استخدمنا Sheet4 وليس ( حركة الخزينة) لان لو كتبنا (حركة الخزينة With) وجيت حضرتك وغيرت اسم الشيت من حركة خزينة الى قاعدة البيانات مثلا لا يتغير اسم الشيت فى محرر الاكواد فهو هيظل ثابت باسم Sheet4 وفى هذه الحاله لا يعمل الكود لانه هيبجث عن شيت حركة الخزينة هيكون غير موجود لكن لو استخدمت With Sheet4 مهما تغير اسم الشيت هيشتغل الكود طيب اى شئ بفتحه فى الاكسيل لازم اقفله انا دلوقتى فتحت With Sheet4 اذن لا بد من قفل With بـــ End With رابعا : اضافه السطر التالى Sub ترحيل() Application.ScreenUpdating = False With Sheet4 Lr = .Cells(.Rows.Count, "D").End(xlUp).Row End With End Sub الجديد هو هذا السطر Lr = .Cells(.Rows.Count, "D").End(xlUp).Row عملنا متغير اسمه LR ويمكنك تغيير الى ما تريد من الاحرف حسب مزاجك حضرتك طيب وعرفناه انه عبارة عن اخر خليه بها بيانات فى عمود D من شيت حركة الخزينة وهى هنا كما هو بالصورة عليه الخلية D4 مكتوب فيها " رصيد افتتاحى" واحد هيقولى مش فاهم هوضح له اكتر مثلا عايز اقول ان " الاستاذ الكبير العلامه ياسر خليل العبقرى" = r فبدل كل شوية ما اكتب الجمله دى " الاستاذ الكبير العلامه ياسر خليل العبقرى " وتاخد منى وقت استعيض عنها بى r فقط / على طول الكود هيفهم معناها خامسا : اضافه السطر التالى Sub ترحيل() Application.ScreenUpdating = False With Sheet4 Lr = .Cells(.Rows.Count, "D").End(xlUp).Row .Cells(Lr + 1, "A") = [D8] End With End Sub ما هو الجديد الجديد هذا السطر [Cells(Lr + 1, "A") = [D8. ماذا يعنى الجزء الاول و هو.("Cells(Lr + 1, "A. (العمود, الصف)Cells. الصف هو Lr+1 يعنى Lr هى اخر صف فى العمود D من شيت حركة الخزينة فيه بيانات ( طيب انا عايز بقى السطر اللى بعده يبقى اقول Lr+1 طيب والعمود هو A وتم كتابته بين علمتى تنصيص "A" ( شيفت + حرف الطاء بالكيبور) طيب عمود A ده عايزين يروح له التاريخ اللى بسند القبض / والتاريخ اللى بسند القبض موجود بالخلية D8 صح اذن اقول [Cells(Lr + 1, "A") = [D8. وهكذا كما هو موضح بالكود يتم ترحيل كامل بيانات السند ثم نغلق With ب End With Sub ترحيل() Application.ScreenUpdating = False With Sheet4 Lr = .Cells(.Rows.Count, "D").End(xlUp).Row .Cells(Lr + 1, "A") = [D8] .Cells(Lr + 1, "B") = [G7] .Cells(Lr + 1, "D") = [D10] .Cells(Lr + 1, "G") = [d11] .Cells(Lr + 1, "E") = "=R[-1]C+RC[2]-RC[1]" End With End Sub اضغط على زر الترحيل ستجد البيانات تم ترحيلها ارجوا من الله ان اكون وفقت فى هذا الشرح ويستفيد منه الجميع ان احسنت فمن الله وما توفيقى الا بالله وان اخطأت فمن نفسى والشيطان وارجوا من الاساتذه الافاضل مراجعه الشرح وتصحيح ما به من أخطأ ولى رجاء من ادارة المنتدى جعل التعديل على الشرح متاح لى حتى يتثنى لى اضافه بعض الاشياء الاخرى تخص نفس الموضوع انا استكفيت بهذا القدر حتى يكون سهل على الاعضاء اللى عايز يطبق وان شاء الله سوف نكمل ما بدأناه تقبلوا منى وافر الاحترام والتقدير خزينة.zip

برنامج المخزون و الفواتير الشامل .... الاصدار الثالث اكسيل 2007 - اكسيل 2010 اليوم بمشيئة الله هو الانطلاق الرسمى لهذة النسخه وبعد انتهاء مرحلة التجربة التى دامت اكثر من شهرين خطوات استخدام البرنامج لأول مره تسجيل البيانات الجديدة داخل البرنامج لعمل فواتير البيع و الشراء و الحركات المالية 1- تسجيل اسماء مناديب البيع وهى خطوه مهمه مطلوبة لتسجيل اسم عميل جديد 2- تسجيل و ادخال العملاء (يتم ربط كل عميل باسم مندوب) 3- تسجيل و ادخال الموردين 4- تسجيل و ادخال اسماء لفئة الصنف وهى خطوه مهمه مطلوبة لتسجيل صنف جديد 5- تسجيل و ادخال الاصناف (ولابد من وجود فئة مدخله مسبقا لكى تستطيع ادخال الصنف) 6- ولا تنسى تسجيل رصيد اول المده فى شاشة البيانات و الجرد الجديد فى هذا الاصدار * واجهة تطبيقية كاملة * برنامج كامل مخزون فواتير ذمم عملاء وموردين واستحقاقات خلال الفترات الزمنية المختلفة * اختصارات سريعة لتنفيذ العمليات و التقارير بسرعة عالية * كشف حساب بطريقة جديدة بمعنى نفترض انه هناك عميل ما علية مديونية بفيمة 15000 فالبرنامج يعطيك كشف حساب تفصيلى للمديونية المستحقة خلال فترات 30 يوم 60 يوم 90 يوم و اكثر من 90 يوم فمثلا فى المثال السابق يكون استحقاق المديونية على حسب فواتير العميل مستحق فى 30 يوم 3000 وفى 60 يوم 6000 وفى 90 يوم 4000 و فى اكثر من 90 يوم 2000 فيكون اجمالى المديونية هم ال 15000 لكن الاستحقاق فى فترات مختلفه وهذا الكشف يفيد كل من يتعامل بالاجل لمعرفة المستحق خلال الفترة التى يريدها وعندما يقوم العميل بسداد جزء من المستحق يتم خصمه من المديونية القديمه بمعنى ان العميل فى المثال السابق قد قام بسداد 1500 فيتم خصمها من ال 2000 وهى مديونية الاكثر من 90 فيصبح كشف حسابة كالتالى مستحق فى 30 يوم 3000 وفى 60 يوم 6000 وفى 90 يوم 4000 وفى اكثر من 90 يوم 1500 فيكون اجمالى المديونية هم ال 13500 * شاشة فواتير جديده تحوى الكثير و الكثير من الاختصارات للعملاء و الاصناف وتوصلك الى عدة تقارير بضغطة زر واحده عرض معلومات عن الصنف و رصيده الحالى داخل المستودع و اخر سعر شراء بمجرد اختيارك للصنف وادخاله داخلة الفاتوره سهولة الغاء وتعديل الصنف داخل الفاتورة عن طريق الدبل كليك ذهاب مباشره الى تقرير صنف معين بمجرد اختياره وضغط تقرير الصنف اكتشف المزيد............ *شاشة لتقرير المديونية خلال الفترات الزمنية المختلفة يجب عليك قراءة ومراجعة شرح البرنامج جيدا حيث توجد العديد و العديد من الاختصارات السريعة التي تنقلك من شاشة الى اخرى بسرعه عالية ولتوفير وقتك داخل البرنامج. كما توفر لك سرعة الحصول على المعلومة المطلوبة. * لتحميل نسخة من الشرح وهى عبارة عن ملف تنفيذي اضغط على الرابط التالى شرح برنامج المخزون و الفواتير الشامل( ملف تنفيذى... 6MB رابط خارجى على موقع ميديا فاير) * او الذهاب الى موضوع شرح البرنامج و مناقشات مشرفى و اعضاء المنتدى داخل المنتدى على الرابط التالى شرح برنامج المخزون و الفواتير الشامل(مشاركة داخل المنتدى) كما احببت ان اقدم مناقشة ونصائح مديري و اعضاء المنتدى للبرنامج لكى يستفيد منها الجميع وهذه المواضيع تم مناقشتها في موضوع شرح البرنامج داخل المنتدى انظر المشاركة التالية لمشاهدة النصائح و المناقشات حول البرنامج واخيرا اقدم لكم البرنامج حجم البرنامج 1.2 MB اختر اسم المستخدم المدير كلمة السر 123 محرر الاكواد 85211 لاتترد فى الاستفسار عن اى شيى داخل البرنامج ضع مشاركتك وسوف يتم الرد عليها كما يمكن مراسلتى على الايميل التالى amroomo@gmail.com اخيرا اتمنى ان يكون هذا البرنامج اضافة الى برامج المخزون و الفواتير وتغيير مسارها على الاكسيل فهذا العمل جديد بكل المقاييس فى افكاره التى اتمنى ان اكون قدمتها بصورة جيدة ويستقيد بها الجميع وَقُلْ رَبِّ زِدْنِي عِلْمًا ========================================================= المرفق المحدث الاخير: SIS 3.152 (Add City).rar

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله موضوع المصفوفات موضوع معقد ومتشعب للغاية ، لا أقصد أنه مستحيل ، ولكنه يحتاج إلى خبرة كبيرة لكي تستطيع أن تتعامل معها ، لذا ارتأيت أن أتعلم التعامل مع المصفوفات ، ولكن لكي أتعلم المصفوفات لابد أن أقدم المعلومة في أسلوب سلس وبسيط .. فهيا بنا سوياً نتعلم معاً ... أنا مثلي مثلكم في الموضوع أنا مجرد متعلم مبتديء فيما يخص هذا الفرع هنتكلم ببساطة ونحاول بقدر الإمكان إننا نبعد عن الأمور المعقدة ، فلنهضم سوياً البدايات ، وبمرور الوقت سنصل إلى الهدف الأكبر إن شاء الله عارفين المتغير Variable لما نحب نخزن قيمة خلية على سبيل المثال كنا نضع قيمة الخلية في متغير بهذا الشكل (بفرض أنه هناك نص في الخلية A1 والمطلوب تخزين قيمة الخلية في متغير ) Sub StringVariable() Dim strName As String strName = Range("A1").Value MsgBox strName End Sub قمنا بالإعلان عن المتغير وفي السطر التاني وضعنا قيمة للمتغير بحيث يساوي قيمة الخلية A1 وفي آخر سطر أظهرنا قيمة المتغير من خلال رسالة في المثال تم تخزين قيمة خلية واحدة ... طيب لو عندي 100 اسم في العمود الأول ..هل كل خلية هعمل متغير وأخزن فيه قيمة الخلية ( طبعاً مستحيـــــــــــــــــــــــــــــــــــل ) من هنا نعرف أهمية التعامل مع المصفوفة ، لإنك من خلال المصفوفة تقدر تخزن أي صف وأي عمود أو حتى أي نطاق مكون من صفوف وأعمدة لو هنتعامل مع صف واحد يبقا المصفوفة (ذات بعد واحد) ، لو مع عمود واحد (بردو ذات بعد واحد) ، لكن لوهنتعامل مع صفوف وأعمدة يبقا في الحالة دي (المصفوفة ذات بعدين ..بعد الصفوف وبعد الأعمدة) نرتاح شوية بعد ماعرفنا ايه فايدة المصفوفة وننتقل لمثال عملي بسيط لكيفية الإعلان عن المصفوفة ..... ارتحنا ..الحمد لله .. ننتقل إلى الجزء الثاني شكل المصفوفة :المصفوفة تتكون من عناصر وكل عنصر له رقم (يعني زي كتاب وله فهرس ..كل صفحة في الكتاب ليها رقم في الفهرس) المصفوفة زي الكتاب ... والعناصر زي الصفحات .. وكل عنصر له رقم في الفهرس زي ما كل صفحة ليها رقم في فهرس الكتاب محرر الأكواد بيتعامل مع المصفوفات ويبدأ يضع فهرس للعناصر بس مش بيبدأ برقم واحد بيبدأ برقم صفر مثال : لو مصفوفة مكونة من 4 عناصر يبقا الفهرس هيكون بالشكل ده ( 0 - 1 - 2 - 3 ) يعني أول عنصر له رقم الفهرس صفر ، وتاني عنصر له رقم الفهرس واحد ، وتالت عنصر له الرقم 2 ، والرابع والأخير له الرقم 3 .... تعبتكم معايا في الفهرس سؤال : هل ممكن إني أخلي محرر الأكواد يغير طريقة الفهرسة لعناصر المصفوفة بحيث يبدأ من رقم 1 ؟ الإجابة نعم (بس اصبر عليا عشان بتوه وبنسى) مثال تطبيقي : ضع الكود التالي في محرر الأكواد Sub OneDimensionalArrayA() Dim Arr(0 To 3) As String Arr(0) = "A" Arr(1) = "B" Arr(2) = "C" Arr(3) = "D" End Sub السطر الأول بنعلن عن المصفوفة بعد اسم المتغيرArr وضعنا بين قوسين حجم المصفوفة من 0 إلى 3 أي أن الفهرس يبدأ من 0 إلى 3 (إذاً عدد عناصر المصفوفة كام ؟ عد من 0 إلى 3 هتلاقي الناتج 4 أي 4 عناصر بالمصفوفة) من محررالأكواد روح للقايمة View وانقر على الأمر Locals window هيظهر نافذة نقدر من خلالها نتابع عمل الكود ضع مؤشر الماوس في أي مكان داخل الإجراء الفرعي المسمى OneDimensionalArrayA ثم من لوحة المفاتيح اضغط F8 ... سنجد السطر التالي مظلل بالأصفر Sub OneDimensionalArrayA() بص كويس على نافذة Locals ستجد المتغير من النوع مصفوفة المسمى Arr على يمينه علامة زائد انقر عليها هيفتح لك عناصر المصفوفة ستجد العنصر الأول بهذا الشكل Arr(0) وهكذا مع بقية العناصر ..كيف عرف محرر الأكواد أن العناصر 4 عناصر ؟؟ لأننا حددنا حجم المصفوفة بين الأقواس نلاحظ أيضاً في نافذة Locals في العمود المسمى Value أن العناصر لا تحمل أي قيمة بعد ، سنجد "" (أقواس تنصيص) أي أنها فارغة ... هذا هو شكل المصفوفة أي أنه يعد بمثابة متغير واحد يحمل عدة متغيرات ... اضغط F8 مرة أخرى ستجد السطر التالي مظلل بالأصفر Arr(0) = "A" لا يوجد أي تغيير في نافذة Locals ... نلاحظ أنه بعد الضغط على F8 والخروج من السطر الأصفر الحالي يتم تنفيذ السطر ..أي أن التنفيذ بعد الخروج من السطر نضغط F8 للمرة الثالثة لتنفيذ السطر السابق سنجد في نافذة Locals في العمود Value أن العنصر الذي له رقم الفهرس صفر يحمل القيمة A أكمل بالضغط على F8 وبعد كل ضغطة لاحظ النافذة جيداً لتعرف التغيرات ماذا كان يحدث في أسطر الكود ..؟ تقوم الأسطر بتعيين قيمة لكل عنصر داخل المصفوفة الآن جرب بنفسك الكود التالي Sub OneDimensionalArrayB() Dim Arr(1 To 4) As String Arr(1) = "A" Arr(2) = "B" Arr(3) = "C" Arr(4) = "D" End Sub لاحظ أننا يمكننا تغيير بداية الفهرسة من صفر إلى 1 كما بالمثال .. لاحظ التغيرات ..بما أن عدد العناصر أربعة تم تغيير الرقم 3 الذي هو آخر رقم بالفهرس إلى 4 .. وفي الأسطر تم التعديل ليناسب التغيير الذي تم بالسطر الأول ننتقل لآخر جزئية الآن .. معرفة أول رقم في الفهرس وآخر رقم في الفهرس نعود للمثال الأول Sub OneDimensionalArrayA() Dim Arr(0 To 3) As String Arr(0) = "A" Arr(1) = "B" Arr(2) = "C" Arr(3) = "D" MsgBox LBound(Arr) MsgBox UBound(Arr) End Sub لمعرفة أول رقم في الفهرس نستخدم الكلمة LBound ثم نفتح قوس ونكتب اسم المصفوفة المطلوبة >> الناتج في المثال سيكون رقم 0 لمعرفة آخر رقم في الفهرس نستخدم الكلمة UBound ثم نفتح قوس ونكتب اسم المصفوفة المطلوبة >> الناتج في الثال سيكون رقم 3 جرب بنفسك تغيير أبعاد المصفوفة من 0 إلى 3 ، وخليها من 1 إلى 4 وغير ما يلزم وشوف النتائج Sub OneDimensionalArrayB() Dim Arr(1 To 4) As String Arr(1) = "A" Arr(2) = "B" Arr(3) = "C" Arr(4) = "D" MsgBox LBound(Arr) MsgBox UBound(Arr) End Sub وإلى لقاء آخر ...دمتم على طاعة الله *********************************************** الجزء الثاني إخواني وأحبابي في الله .. بعد أن تعرفنا على الشكل العام للمصفوفة وعرفنا أنها مكونة من عناصر وكل عنصر له رقم في فهرس المصفوفة نتعرف الآن على طريقة أخرى لتخزين قيم المصفوفة .. في السابق خزنا كل قيمة داخل عنصر تباعاً أي تم تعيين قيمة لكل عنصر ..عنصر عنصر الطريقة التي سنتعلمها الآن هي كيفية تخزين مجموعة من القيم مرة واحدة بسطر واحد .. الأمر في منتهى اليسر ، سنقوم باستخدام كلمة Array ثم نفتح قوس بالضغط على Shift + 9 ثم نضع القيم بالترتيب المطلوب وكل قيمة توضع داخل أقواس تنصيص ويفصل بين كل عنصر وعنصر فاصلة وليس فاصلة منقوطة وفي نهاية المطاف نغلق القوس بالضغط على Shift + 0 اختصار للكلام الكتير شوف السطر ده ..هنخزن قيم المصفوفة بهذا الشكل Arr = Array("A", "B", "C", "D") تم تخزين 4 قيم داخل المصفوفة .. لمعرفة أول الفهرس نستخدم كلمة LBound ولمعرفة رقم آخر الفهرس نستخدم كلمة UBound كما عرفنا من قبل لو ضغطنا F8 وتفحصنا نافذة الـ Locals سنجد أن الفهرس يبدأ من صفر .. إذاً أرقام الفهرس هنا في السطر السابق ستكون 0 ، 1 ، 2 ، 3 طيب نضع المثال بالكامل ثم نقوم بشرحه وتشريحه Sub OneDimensionalArray3() Dim Arr Arr = Array("A", "B", "C", "D") Range("A1").Resize(1, UBound(Arr)) = Arr Range("A2").Resize(UBound(Arr), 1) = Application.Transpose(Arr) End Sub في المثال تم الإعلان بشكل عام عن المصفوفة دون تحديد أبعادها كما فعلنا من قبل تم وضع قيم المصفوفة في السطر الثاني كما أسلفنا المطلوب الآن أن نعرف كيف نقوم بوضع قيم المصفوفة داخل نطاق وهذا الأمر في غاية الأهمية السطر الثالث يقوم بوضع القيم في الصف الأول بدايةً من الخلية A1 إلى ؟؟ النهاية مجهولة في الغالب ..عشان كدا بنعتمد على آخر رقم في المصفوفة باستخدام UBound بمعنى آخر : فيه خاصية اسمها Resize (إعادة تحجيم) فالسطر بيقول ايه؟ انطلاقاُ من الخلية A1 سيتم تحديد حجم النطاق طبقاً للأرقام داخل الخاصية Resize الرقم الأول يمثل عدد الصفوف والرقم الثاني يمثل عدد الأعمدة .. بما إننا عايزين نضع القيم في الصف الاول فقط يبقا عدد الصفوف هيكون واحد .. أما عدد الاعمدة هيكون مرتبط بطول المصفوفة وعشان نعرف طول المصفوفة زي ما قلنا نعرف آخر رقم فيها باستخدام كلمة UBound ..طيب جميل أوي لحد دلوقتي !! نيجي للقاضية . طول المصفوفة في المثال 4 عناصر لكن لو استخدمنا كلمة UBound عشان نعرف آخر رقم يبقا في الحالة دي هيكون الناتج 3 مش 4 (يا دي الحيرة) المشكلة إن المصفوفة بتبدأ من صفر عشان كدا نهايتها عند الرقم 3 .. لو تركنا المثال زي ما هو كدا ..ايه اللي هيجرا .. الجزء التاني الخاص بعدد الأعمدة اللي هو ده UBound(Arr) الناتج هنا لو حسبنا بشكل يدوي يساوي 3 إذاً سيتم تحجيم النطاق بمقدار صف واحد و3 أعمدة .. فلو بصينا على الورقة بعد تنفيذ الكود هنلاقي القيمة A في الخلية A1 ، والقيمة B في الخلية B1 ، والقيمة C في الخلية C1 ووقف لحد هنا .لأننا حددنا عدد الأعمدة 3 من خلال رقم آخر فهرس في المصفوفة .. طيب إزاي نحل الإشكالية دي ؟؟ ببساطة إحنا عارفين إن المصفوفة بدأت من الصفر يبقا في الحالة دي عشان نحدد عدد الأعمدة نزود واحد وخلصت الحكاية يعني السطر هيكون بالشكل ده Range("A1").Resize(1, UBound(Arr) + 1) = Arr فيه طريقة تانية نخلص من المشكلة بشكل نهائي إننا نضع جملة Option Base 1 يتم وضعه خارج الكود في قسم الإعلانات العامة في الموديول وفي الحالة دي مفيش داعي نزود واحد في السطر لأننا حلينا المشكلة بشكل تاني يعني الكود هيكون بالشكل ده Option Explicit Option Base 1 Sub OneDimensionalArray3() Dim Arr Arr = Array("A", "B", "C", "D") Range("A1").Resize(1, UBound(Arr)) = Arr Range("A2").Resize(UBound(Arr), 1) = Application.Transpose(Arr) End Sub ننتقل لآخر سطر ونعرف ايه الاختلاف .. ركز وحاول دايماً تشوف الفرق .. في السطر السابق للسطر الأخير وضعنا قيم المصفوفة في الصف الأول في الأربعة أعمدة A - B - C - D في السطر الأخير يتم وضع القيم بشكل رأسي وليس أفقي أي وضعها في عمود (والمصفوفة تتعامل مع الصفوف بشكل أيسر لأنها تعتبر على شكل صف في المثال الذي نقوم بشرحه) السؤال إزاي هنخلي المصفوفة تقرا القيم بشكل رأسي .. الموضوع بسيط جداً بس نشرحه من خلال الإكسيل الأول روح لورقة العمل وحدد أي مجموعة قيم في صف واحد ... يعني مثلاً حدد النطاق A1:D1 واعمل Copy نسخ وتعال في أي خلية بعيد شوية واعمل كليك يمين ثم Paste Special أي لصق خااااص وعلم علامة صح على الخيار Transpose الموجود في النافذة اللي هتظهر لك ولاحظ ما يحدث هتلاقي القيم اتغيرت من الشكل الأفقي للشكل الرأسي وهو دا حل المشكلة .. أي لوضع القيم في عمود نستخدم الجملة Application.Transpose عشان نحول المصفوفة من شكل أفقي لشكل رأسي طبعاً مننساش إن خاصية Resize هنا هتختلف : بمعنى عدد الصفوف هنا يمثل عدد عناصر المصفوفة أما عدد الأعمدة فعمود واحد ... بص للسطرين عشان تعرف الفرق ما بين وضع القيم بشكل أفقي ووضعها بشكل رأسي مش هطول عليكم عشان نقدر نستفيد وأنا معاكم بستفيد مثلكم تماماً .. تقبلوا تحياتي وإلى لقاء آخر متجدد بإذن الله ********************************************************************** الجزء الثالث إخواني الكرام نتعرف اليوم على الحلقات التكرارية للمصفوفة أو تحديداً لعناصر المصفوفة نفترضأن لدينا مصفوفة مكونة من 5 عناصر ونريد وضع قيم هذه المصفوفة في 5 صفوف في النطاق A1:A5 (تعلمنا أننا يمكننا ذلك في سطر واحد ..راجع ما سبق) ولكن كنوع من التدريب على استخدام الحلقات التكرارية سنقوم بعمل حلقة تكرارية لوضع قيم عناصر المصفوفة في الخمس خلايا لعمل حلقة تكرارية نقوم أولاً بالتفكير .. ما هو المتغير الذي سيجعلنا نقوم بالحلقة التكرارية (هنا قد يكون المتغير الصف .. لأننا نريد أن نضع قيمة في الصف رقم 1 ثم الصف رقم 2 ثم الصف رقم 3 وهكذا ... وقد يكون المتغير عناصر المصفوفة لأننا نتعامل مع العنصر رقم 1 ثم العنصر رقم 2 ثم العنصر رقم 3 وهكذا) بذلك تتضح الحلقة التكرارية أننا نريد أن نقوم بتنفيذ سطر محدد عدد من المرات بالمثال يتضح المقال Sub LoopArrays() Dim I As Integer Dim Arr(1 To 5) As Integer Arr(1) = 10 Arr(2) = 20 Arr(3) = 30 Arr(4) = 40 Arr(5) = 50 For I = LBound(Arr) To UBound(Arr) Cells(I, "A") = Arr(I) Next I End Sub هذا هو الكود بالكامل .. نبدأ في عملية التشريح السطر الأول دا المتغير اللي هنخزن فيه قيمة المتغير أثناء الحلقة التكرارية.. بمعنى مع كل لفة مع كل حلقة تكرارية فيه راجل ماسك الراية ومع كل لفة بيرفع راية جديدة المتغير I في السطر الأول سيكون بمثابة حكم الراية ..في أول لفة تلاقيه رافع راية احدة (حسب نقطة البداية ...يعني ممكن تكون نقطة البداية لا تساوي 1 ...ممكن الحلقة التكرارية تبدأ من أي رقم تاني غير الواحد ...المهم في المثال إحنا هنبدأ من 1) ... نرجع تاني لحكم الراية ..مع اللفة التانية هيكون قيمة المتغير 2 ومع اللفة التالتة هيكون 3 وهكذا .... السطر التاني اتعودنا عليه ..الإعلان عن مصفوفة أحادية الأبعاد بدايتها 1 ونهايتها 5 (ممكن نكتب بين القوسين 5 بس .. بس هتقابلك مشكلة إن المصفوفة هتترقم في الحالة دي بدايةً من الصفر ...راجع الجزء الأول والثاني) الأسطر التالية بيتم فيها تخزين قيم المصوفة : العنصر الأول في المصفوفة هيكون قيمته 10 ، والثاني 20 وهكذا نيجي بقا للحلقة التكرارية في نهاية الكود ... بعد الإعلان عن المصفوفة وتخزين القيم لعناصر المصفوفة ، تيجي الحلقة التكرارية عشان نقدر نعدي على كل عناصر المصفوفة بنستخدم الجملة For بعديها حكم الراية .... بعد كدا علامة يساوي ونحدد نقطة الإنطلاق أونقطة البداية ونقطة النهاية وبين البداية والنهاية كلمة To نقطة البداية هتكون رقم الفرس لأول عنصر في المصفوفة : ودي عرفنا إزاي نجيبها من خلال LBound وبين قوسين بنكتب اسم المصفوفة ونفس الكلام مع نقطة النهاية ودي هتكون رقم الفهرس لآخر عنصر في المصفوفة وبردو عرفنا إزاي نجيبها من خلال كلمة UBound وبين قوسين اسم المصفوفة يبقا خلاصة السطر الأول في الحلقة التكرارية ..بنقول إننا هنبدأ منين وننتهي فين ولازم القفلة يعني جملة For لازم يكون ليها مقابل أوقفلة والقفلة هي السطر Next I ... دي زي الترس اللي بيدور العجلة (حلو التشبيه ده) والترس ده يقف لما حكم الراية يوصل لنقطة النهاية بلغة البرمجة : لما المتغير I يساوي نقطة النهاية (زي المثال نقطة النهاية تساوي 5) لما المتغير I يساوي 5 ، بكدا تتوقف الحلقة التكرارية ..أي يتوقف الترس المهم في الكود كله السطر اللي بين سطري الحلقة التكرارية (هو دا اللي هيتنفذ مع كل لفة) Cells(I, "A") = Arr(I) كلمة Cells اللي يعرف شوية في البرمجة يعرف إنها متبوعة بين قوسين برقم الصف ورقم أو اسم العمود فلو كنا في اللفة الأولى يبقا المتغير I يساوي واحد ...في الحالة دي رقم الصف هو 1 واسم العمود A أي الخلية A1 >> ملحوظة هامة ممكن نشيل حرف "A" ونضع مكانه رقم العمود 1 بالشكل ده cells(I,1) يبقا الخلية A1 تساوي ؟؟؟ مجهول !!! تساوي العنصر في المصفوفة الذي يحمل رقم الفهرس ..يعني إحنا قلنا إن المتغير I يساوي واحد إذاً الخلية A1 تساوي أول عنصر في المصفوفة ثم تبدأ اللفة الثانية ويتغير المتغير I يصبح 2 فنبدأ بالتعامل مع الصف الثاني والعمود الأول أي الخلية A2 ونقول تساوي قيمة ثاني عنصر من عناصر المصفوفة وهكذا وهكذا أرجو أن أكون وفقت في توصيل المعلومة شكل سلس يسهل معه فهم البرمجة وفهم كيفية التفكير العلمي والكروي والميكانيكي (حيث تحدثنا بلغة البرمجة وتطرقنا للغة كرة القدم وأخيراً عملنا بالميكانيكا مع التروس) تقبلوا تحياتي

السلام عليكم روحمة الله وبركاته الى كافة الاعضاء المتميزين في هذا الصرح الكريم نبارك لكم بترقية الموقع وإن شاء الله دائما في تطوير وتحديث موضوعي اليوم هو كثير الاستفسار والاسئلة حوله وهي تحويل ملف إكسل الى صيغة ملف exe ومن خلال بحثي في الموقع شاهدت موضوع أخونا وأستاذي الكبير شوقي ربيع حول تحويل ملف اكسل الى صيغة exe والتعديلات التي أجراها أخونا ضاحي الغريب بارك الله فيه لكي يعمل الملف على كافة الانظمة رابط موضوع أستاذي شوقي ربيع http://www.officena.net/ib/topic/49169-شرح-تحويل-ملف-الاكسل-الى-exe-ثم-تغيير-الايقونة-ثم-setup-شوقي-ربيع/ وعندما شاهدت برنامج أخونا ضاحي الغريب والتميز الذي أنشائه في فكرة تصميمات الفورم وكيف نجعل إكسل ونجبره على فعل أي شي نريده في مجال البرمجة رابط برنامج أخي ضاحي الغريب http://www.officena.net/ib/topic/56375-برنامج-نور-التجاري-والخدمي-هدية-العام-الهجري-الجديد/ لف أنتباهي شي جميل جداً هو كيف عندما نقوم بتحميل الملف من الموقع وبعدها نقوم بتنزيل البرنامج على جهاز الكمبيوتر يفتح الملف : أولا : من غير مشاهدة واجهة إكسل 2010 أو 2007 ثانياً: تفعيل الماكرو والكودات تلقائياً لولا خبرتي المتواضعة في مجال الفورمات والتصميمات في هذا المجال لكنت قلت أن البرنامج مبرمج على بيئة فيجوال بيسك من غير الاكسل ولكن هو طبعا ملف إكسل فنرجو من الاستاذ الكبير والساعي للخير دائما في مجال تسهيل العلم لطالبه ضاحي الغريب أن يعلمنا بالظبط ماهو الكود الذي أجبر إكسل على تفعيل الماكرو تلقائيا والامر الثاني كيف لم تظهر نافذة إكسل وظهرت نافذة لمدة ثانية واحدة أو اقل وهي مكتوب فيها الرجاء الانتظار باللغة الانكليزية وبعدها مباشرة ظهر فورم البرنامج قصة التحويل الذي ذكره أخونا شوقي ربيع سهل ولكن ظل عند تحويل الملف وبعدها تثبيته وفتحه ظهر ملف إكسل وبعدها قمنا بتفعيل الماكرو أختفى ملف إكسل مباشرة وظهر الفورم كان لدي منذ فترة بعيدة حوالي سنتين أو أكثر موضوع في هذا المجال ولم تكن الاجابات على قدر المستوى الرجاء ثم الرجاء من أخونا ضاحي الغريب الشرح حول هذين الطلبيين وكيفية تفعيلهم في برامج اكسل لأنه أجهر حاليا برنامج نسأل الله عزوجل أن يكون متميزا وجديد في فكرته وهو برنامج محاسبة المصانع الذي يعمل وفق (محاسبة التكاليف) برنامج متكامل بكافة التفاصيل من ناحية الحسابات وادارة الموظفين والفواتير والايصالات والتقارير المالية والمخزون نسأل الله عزوجل أن يكون الموضوع متفاعل من قبل الاستاذ ضاحي الغريب وباقي الاعضاء ونطلب من إدارة الموقع تثبيت الموضوع نظراً لاهميته من نواحي عديدة منها حماية الحقوق للمبرمج صور من البرنامج المذكور شاركوني رأيكم في التصميم والبرمجة في الموضوع لكي يكون سهل المنال لاي شخص يسعى للعلم والمعرفة

الحمد لله الذي بنعتمه تتم الصالحات يرجى أن يكون عنوان الموضوع معبر عن الطلب .. ولا تذكر أسماء الأعضاء في العنوان عنوان معبر عن الطلب تقبل تحياتي

أخي الكريم أشرف قلت لك اللي يطارد عصفورين يفقدهما فتحت موضوعين بطلبين ..شيء جميل لكن أفضل طالما إن العمل على ملف واحد يبقا طلب طلب .عشان تبني الطلب اللي جاي على الملف ده عموماً اتفضل الملف التالي وشوف النتائج بشكل جيد وتفحص الملف جيداً .. حتى إذا اطمأن قلبك قم بإرفاق الملف الجديد في الموضوع الجديد بالطلب الجديد يا أستاذ سعيد .. تقبل تحياتي Export Workbooks Using Filter Method V1.rar

تسمحون لي في ادلاء دلوي جرب النموذج frm2 ، انا استعرت كود اخونا عبدالرحمن ، وعدلت عليه ، فاصبح: Private Sub txt_KeyUp(KeyCode As Integer, Shift As Integer) Select Case KeyCode Case Is = vbKeySpace Exit Sub Case Else Call counting End Select End Sub Function counting() a = Me.txt.Text Me.txt_len = Len(a) Me.txt_letters = Len(Replace(a, " ", "")) Me.txt_words = Len(a) - Len(Replace(a, " ", "")) + 1 End Function . وممكن تجرب frm1 كذلك جعفر 209.عدد الحروف والكلمات مهم--edit.accdb.zip

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

ببساطة شيل المرجع A1 من المعادلة دي =MROUND(A1;10) وضع مكانها المعادلة المرجوة بدون علامة يساوي U4/100)*40 )

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

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

السلام عليكم جزيت خيرا سوف اوضح اذكر واضبط المطلوب

وعليكم السلام أخي وائل انت كتبت اسم BE بالخطأ ، وعدلت انا الشئ البسيط على البرنامج كذلك ، فاليك الكود المعدل: Private Sub Form_Close() On Error GoTo err_Form_Close 'make a backup of BE BE_or_FE = "C:\My Documents\Downloads\Officena.net\208.A" Backup_Folder = "C:\back_folder" 'Do a copy from a PC name jj ONLY If VBA.Environ("Computername") <> "wael" Then Exit Sub 'Delete the old saved accdb Kill Backup_Folder & "\AA_BE_*.accdb" 'Now lets work on saving the new accdb''Is this PC name = jj' ' BE_Address = BE_or_FE & "\AA_BE.accdb" BK_Address = Backup_Folder & "\AA_BE_" & Format(Now(), "yyyy-mm-dd_-hh-mm-ss") & ".accdb*" 'Debug.Print "xcopy " & Chr(34) & BE_Address & Chr(34) & " " & Chr(34) & BK_Address & Chr(34) Call Shell("xcopy " & Chr(34) & BE_Address & Chr(34) & " " & Chr(34) & BK_Address & Chr(34), vbHide) Exit Sub err_Form_Close: If Err.Number = 2450 Or Err.Number = 53 Then 'ignor Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub رجاء عدم تغيير الكود ، الإ السطرين التاليين فقط ، وهما لتحديد مسار BE ، وتحديد مسار back_folder جعفر 208.AA.mdb.zip

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

الأخ الكريم يرجى تغيير اسم الظهور للغة العربية .. راجع موضوع التوجيهات في الموضوعات المثبتة في المنتدى إليك الملف التالي تصنيف.rar

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

وعليكم السلام أخي محمد أخي رمهان ، رحم الله والديك على السؤال عني السؤال ظاهرا سهل ، ولكنه ليس كذلك اللي عملته هو: 1. تغيير اسم النموذج الى frm_wared ، والنموذج الفرعي الى sfrm_emp_wared ، 2. في النموذج الرئيسي ، اضغط على زر المجلد ، وتستطيع اختيار المجلد الذي به الملفات: . 3. اضفت حقل جديد في الجدول للنموذج الفرعي ، اسمه File_Check ، ونستفيد منه في تلوين وتعريف السجل ، وعملناه مخفي: . 4. عملنا تنسيق شرطي لأحد الحقول (تستطيع ان تعمله لبقة الحقول ان احببت): . وهذان هما الشرطان فيه: . والالوان معناها: اللون الابيض: هناك ملف في المجلد بنفس الاسم ، اللون الاخضر: هذا السجل لا يوجد ملف بنفس اسمه ، اللون الازرق: هذا الملف موجود في المجلد وغير موجود في السجلات، . 5. وهذه نتيجة احد السجلات: . 6. وعندما تريد حذف السجل: . العمل على البرنامج اسهل من شرحه وهذا هو الكود كاملا: Option Compare Database Private Sub cmd_Open_Folder_Click() Dim strFolderName As String Dim strMsg As String If Len(Me.pate & "") <> 0 Then Dim Msg, Style, Response Msg = "مسار الملف موجود ، هل تريد تغيير المسار" & vbCrLf & _ "هل انت متاكد انك تريد الاستمرار في العملية" & vbCrLf & _ "Do you want to continue ?" Style = vbYesNo + vbCritical + vbDefaultButton2 Response = MsgBox(Msg, Style, Title, Help, Ctxt) If Response = vbYes Then strMsg = "رجار اختيار المجلد" & vbCrLf & _ "What Folder you want to select?" strFolderName = BrowseFolder(strMsg) If Len(strFolderName & "") <> 0 Then Me.pate = strFolderName Me.name_folder = Mid(Me.pate, InStrRev(Me.pate, "\") + 1) End If End If Else strMsg = "رجار اختيار المجلد" & vbCrLf & _ "What Folder you want to select?" strFolderName = BrowseFolder(strMsg) If Len(strFolderName & "") <> 0 Then Me.pate = strFolderName Me.name_folder = Mid(Me.pate, InStrRev(Me.pate, "\") + 1) End If End If 'Len 'now bring the files from the folder Call Make_File_Array End Sub Function Make_File_Array() On Error GoTo err_Make_File_Array 'Folder info Dim File_Count As Integer Dim fdr As Variant Dim Files_Array() As Variant iPath_In = Me.pate iCondition = "*.*" 'No Path, exit If Len(iPath_In & "") = 0 Then Exit Function 'get the file count from the Forlder, and 'place the files in an array fdr = Dir(iPath_In & "\" & iCondition) File_Count = 0 Do While fdr <> "" File_Count = File_Count + 1 ReDim Preserve Files_Array(File_Count) Files_Array(File_Count) = fdr fdr = Dir Loop 'got the folder file count=File_Count, and the files=Files_Array(i) 'SubForm Records Dim rst As DAO.Recordset Set rst = Me.sfrm_emp_wared.Form.RecordsetClone rst.MoveLast: rst.MoveFirst RC = rst.RecordCount '1. Make all Records, File_Check=1 (No File) For j = 1 To RC rst.Edit rst!File_Check = 1 rst.Update rst.MoveNext Next j '2. Compare For i = 1 To UBound(Files_Array) 'File_Count iname_morfke = Files_Array(i) itayp = Mid(Files_Array(i), InStrRev(Files_Array(i), ".") + 1) rst.FindFirst "name_morfke='" & iname_morfke & "'" If rst.NoMatch Then 'No Match rst.AddNew rst!name_morfke = iname_morfke rst!tayp = itayp rst!File_Check = 2 rst!emp_id = Me.id_m rst.Update Else 'Matching 'but is it the same extension If rst!tayp = itayp Then 'Matching rst.Edit rst!File_Check = 0 rst.Update Else 'No Match rst.AddNew rst!name_morfke = iname_morfke rst!tayp = itayp rst!File_Check = 2 rst!emp_id = Me.id_m rst.Update End If End If Next i rst.Requery Exit Function err_Make_File_Array: If Err.Number = 3021 Then 'ignor, SubForm is empty Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Function Private Sub Form_Current() 'now bring the files from the folder Call Make_File_Array End Sub جعفر 207.1.m.salama.accdb.zip

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

P السلام عليكم إخوتي الكرام...جزى الله خيراً من شارك ومن مر على موضوعنا مروراً عطراً ...وما زلنا ننتظر ...نبدأ على بركة الله تعالى: حيث كما أسلف الأخ الصقر أن مفترق الطرق بين القسمين الأول والثاني هو زر الاختيار جديد المسمى ChNew Private Sub ChNew_Click() On Error GoTo 1 If ChNew.Value = True Then Clear ChCmdSearch.Value = False ChCash.Value = True CmdSearch.Visible = False TxNo.Visible = True LabNo.Caption = "رقــم السنـد / " CmdPrint.Visible = False CmdSave.Visible = True CmdEdit.Visible = False ChCash.Value = True Lpay.Caption = "سند صرف" CkqTxt.Visible = False Lbl40.Visible = False ChNames.Visible = True L1.Visible = False Chabout.Visible = True L2.Visible = False ChBank.Visible = True L3.Visible = False m = sheet1.[M9] mm = 9 Do Until sheet1.Cells(mm, "a").Text = "" mm = mm + 1 Loop TxNo.Value = mm + 1 - 10 + m TxDate.Text = Format(Date, "yyyy/mm/dd") End If 1 End Sub فعندما نختار الزر "جديد" يوقف العمل بزر البحث وسيفعل حقل قيمة المبلغ وكذلك ليبل رقم السند وحقل الحفظ دون الطباعة وعند ما يفعل حقل الدفع نقداً يوقف العمل بمجال الشيكات وكذلك يبدأ الترقيم استناداً إلى الخلية M9 في Sheet1 ليبدأ الترقيم في العمود A بدءاً من الرقم في M9 وفي حقل التاريخ يوضع التاريخ بتنسيق معين. أما التفقيط فيؤخذ من Module2 وهنا اختار العملة "درهم" و أجزاؤه "فلس"

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

Private Sub حقل1_Change() 'رمهان اوفيسنا x = حقل1.Text حقل1 = x Me.حقل1.SelStart = Len(x) End Sub

الاخ العزيز بنسبه لسؤال الاول ضع معيار فى استعلام كلاتي Date() + 2 تحياتى

جرب الكود بهذا الشكل Sub فحص() On Error Resume Next Set ww = Application.WorksheetFunction LastRow = Cells(Rows.Count, "B").End(xlUp).Row Application.ScreenUpdating = False Range("A6:A" & LastRow).ClearContents Range(Cells(6, 10), Cells(1000, 10)).ClearContents For R = LastRow To 6 Step -1 If Cells(R, 2).Value = Range("H2").Value Then If ww.CountIf(Range("B6:B" & R), Cells(R, 2).Value) > 1 Then Cells(1000, 10).End(xlUp).Offset(1, 0) = Cells(R, 2) Range(Cells(R, 2), Cells(R, 15)).EntireRow.Delete End If End If Next Range("B6:O1000").Sort [B5], xlAscending For N = 6 To LastRow If Cells(N, 2) <> "" Then Cells(N, 1) = Cells(N, 2).Row - 5 End If Next Application.ScreenUpdating = True Cells(6, 10).Select On Error GoTo 0 End Sub

اليك الكود التالى يؤدى الغرض شرط ان لا يكون التكست بوكس 1 منشط بالفعل قم بلصق الكود داخل الفورم Private Sub TextBox1_Enter() TextBox1.Value = "" End Sub

اخى الكريم هذا ما فعلتة فى المرفق السابق اعتقد انك لم تجربة وها هو المرفق مرة اخرى خالد.rar

اخى الكريم اليك المرفق وهو كود لااستاذ حمادة عمر غير العنوان الى السعودية او اى دولة ولاحظ النتائج طريقة تصميم فورم بحث عن طريق لست بوكس4_5.rar

جرب التعديل البسيط Sub فحص() On Error Resume Next Set ww = Application.WorksheetFunction LastRow = Cells(Rows.Count, "B").End(xlUp).Row Application.ScreenUpdating = False Range("A6:A" & LastRow).ClearContents Range(Cells(6, 10), Cells(1000, 10)).ClearContents For R = 6 To LastRow If ww.CountIf(Range("B6:B" & R), Cells(R, 2).Value) > 1 Then Cells(1000, 10).End(xlUp).Offset(1, 0) = Cells(R, 2) Range(Cells(R, 2), Cells(R, 15)).EntireRow.Delete End If Next Range("B6:O1000").Sort [B5], xlAscending For N = 6 To LastRow If Cells(N, 2) <> "" Then Cells(N, 1) = Cells(N, 2).Row - 5 End If Next Application.ScreenUpdating = True Cells(6, 10).Select On Error GoTo 0 End Sub

فكرة استخدامها بشكل أساسي هو الاحتفاظ بالقيم الفريدة أي الغير مكررة فقط ... كيفية استخدامها : هناخد الكود الخاص بحدث بدء الفورم كمثال Private Sub UserForm_Initialize() Dim Rng As Range Dim Dn As Range Dim Dic As Object With WS Set Rng = .Range(.Range("A4"), .Range("A" & Rows.Count).End(xlUp)) End With Set Dic = CreateObject("Scripting.Dictionary") Dic.CompareMode = vbTextCompare For Each Dn In Rng: Dic(Dn.Value) = Empty: Next Me.ComboBox1.List = Application.Transpose(Dic.keys) End Sub مع بداية تشغيل الفورم يتم تعبئة الكومبو الأول بالقيم الفريدة من العمود الاول الأسطر الأولى مفيش مشكلة فيها الإعلان عن المتغيرات ، تعيين النطاق ..بعدها يتم تعيين متغير من النوع كائن (اللي هو زي القاموس) وفايدته زي ما قلت إنه بيتم تخزين القيم الفريدة أي الغير مكررة فيه .. السطر الذي يليه للتعامل مع الأحرف الحساسة (السطر يتغاضى عن حالة الأحرف ... فلو كتبنا في الخلية A32 كلمة Yasser وكتبنا في الخلية A33 كلمة yasser .... وشغلنا الفورم وشوفنا القايمة المنسدلة هتلاقي أول كلمة بس هي اللي موجودة ، وتم التغاضي عن الكلمة الأخرى أي أن حالة الأحرف غير هامة ..) السطر التالي عبارة عن 3 أسطر وهو عبارة عن حلقة تكرارية For Each Dn In Rng Dic(Dn.Value) = Empty Next Dn الكائن دا شبيه بالمصفوفة بيتم تخزين عناصر فيه ولكن ميزته إنه بيخزن العنصر أو القيمة مرة واحدة فقط مع كل حلقة تكرارية .. لو اتبعت أسلوب التنقيح Debug بالضغط على F8 ستجد أنه مع كل حلقة تكرارية يتم تخزين عنصر جديد ..اسم العنصر هنا مفتاح يعني المصفوفة ليها عناصر أما الكائن القاموس ده فله مفاتيح المهم كل مفتاح مميز .. يعني يحمل قيمة واحدة فقط في السطر الأخير بيتم وضع المفاتيح في الكومبو أي تعبئة الكومبو بمفاتيح القاموس .. وطبعاً لأنها شبيهة بالمصفوفة فاستخدمنا كلمة Transpose لأن المفاتيح زي عناصر المصفوفة بتكون على شكل أفقي وعشان نخليها على شكل رأسي بنستخدم الكلمة دي .... يمكن إضافة السطر التالي لوضع مفاتيح القاموس في عمود واحد Range("G1").Resize(Dic.Count, 1).Value = Application.Transpose(Dic.keys) لاحظ هنا تم استخدام كلمة Count لعد مفاتيح القاموس .. أرجو أن أكون قد وفقت في توصيل المعلومة

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

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

أخى الغالى ( عادل ) أنت كبرتنى جدا جدا فى المقام وده والله لاأستحقة شكرا أخى على شعورك الرائع هذا وربنا يبارك فيك أما عن محرر الأكواد ليس به إلا ( scroll erea ) لتحديد حجم الشاشة الظاهرة فقط والباسورد ( 1964 ) أنتم عندى أكبر من أى برنامج ، وأى أسرار لاتغلى على أعضاء هذا المنتدى شكرا أخى وتقبل تحياتى