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

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

السلام عليكم . . . . والنتيجة: جعفر

أخي الكريم مهند جرب المعادلة التالية =IFERROR(LEFT(A2,1)&". "&MID(A2,FIND(" ",A2)+1,LEN(A2)),"") إذا لم تعمل المعادلة غير الفاصلة العادية لفاصلة منقوطة تقبل تحياتي

أخي الكريم حسام أعتذر إن كان كلامي قد ضايقك لكن يتحتم علي توضيح النقاط الغامضة لتجد المساعدة أعتقد أنه يمكنك حل المشكلة ببساطة من خلال تسجيل ماكرو تقوم فيه بعمل تذييل لورقة العمل وإضافة ما شئت من نصوص أو غيرها .. ثم يمكنك استخدام الكود الذي تم تسجيله هذا كحل مبدئي يمكنك الاعتماد عليه .. أو يمكنك التعديل في هذا الكود ليحقق المطلوب .. وفيه شرح للأسطر المهمة فقط Sub InsertHeaderFooter() Dim Ws As Worksheet Application.ScreenUpdating = False For Each Ws In ThisWorkbook.Worksheets With Ws.PageSetup .LeftHeader = "" 'رأس الصفحة الأيسر.. .CenterHeader = "" 'رأس الصفحة الأوسط.. .RightHeader = "" 'رأس الصفحة الأيمن.. .LeftFooter = "YasserKhalil" 'تذييل الصفحة الأيسر .CenterFooter = "" 'تذييل الصفحة الأوسط .RightFooter = "" 'تذييل الصفحة الأيمن End With Next Ws Set Ws = Nothing Application.ScreenUpdating = True End Sub يقوم الكود بإدراج ما سيتم الكتابة بين أقواس التنصيص في المكان المخصص لذلك لكل أوراق العمل الموجودة تقبل تحياتي

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

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

أخي العزيز إبراهيم إليك إصدار آخر من الكود يقوم بتنسيق الخلايا كما تريد بدون اللجوء إلى التنسيق اليدوي ، كما يتم عمل فاصل للصفحات كما ترغب بعد كل 45 اسم بدون تدخل منك أيضاً كل ما عليك ان تنقر على زر الأمر وبعدها لا تنساني بدعوة بظهر الغيب Sub PopulateData() Dim Ws As Worksheet, Sh As Worksheet Dim I As Long, Col As Long, LR As Long, J As Long Set Ws = Sheet1: Set Sh = Sheet2 Col = 1 Application.ScreenUpdating = False With Sh .ResetAllPageBreaks With .Range("A1").CurrentRegion .Offset(1).Interior.Color = xlNone: .Offset(1).ClearContents: .Borders.LineStyle = xlNone End With End With With Ws For I = 2 To .Cells(Rows.Count, 1).End(xlUp).Row Step 45 .Cells(I, 1).Resize(45, 2).Copy Sh.Cells(Sh.Cells(Rows.Count, Col).End(xlUp).Row + 1, Col).PasteSpecial xlPasteValues If Col = 11 Then Col = 1 LR = Sh.Cells(Rows.Count, 1).End(xlUp).Row Sh.HPageBreaks.Add Before:=Sh.Cells(LR, 1).Offset(1, 0) Else Col = Col + 2 End If Next I End With With Sh With Sh.Range("A1").CurrentRegion .Borders.Weight = xlThin: .BorderAround Weight:=xlThin: .Range("A1").Select End With LR = Sh.Cells(Rows.Count, 1).End(xlUp).Row For J = 1 To 12 Step 2 .Range(.Cells(2, J), .Cells(LR, J)).Interior.Color = RGB(192, 192, 192) Next J End With Application.CutCopyMode = False Application.ScreenUpdating = True End Sub تقبل تحياتي Populate Data From One Column To Multiple Columns YasserKhalil V2.rar

تم معالجة الامر اضافة قائمة منسدلة salim 1.rar

اخي العزيز هذا ليس قسم للدعاية واذا كان البرنامج قيد التجهيز لعرضه لاخوانك داخل المنتدى من باب افادة الاخرين فلا داعي لمقدمات وعند الانتهاء منه يتم عمل موضوع له وارفاقه غير ذلك سيتم حذفه الان في انتظار مرفق او الحذف لحين الانتهاء منه S'il vous plaît joindre un fichier ou la suppression

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

برنامج المخزون و الفواتير الشامل .... الاصدار الثالث اكسيل 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

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

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

احسنت وبارك الله فيك يا بوعبدالله في المرفق فوائد جمة وزيادة على ما تفضل به اخونا جعفر 1- لا يمكن الارتباط به حال كونه مخفيا 2- لو قلنا اننا نقوم باظهاره عند تشغيل البرنامج فهنا المشكلة التي نسعى بالاصل لاخفائها واعتقد يمكننا تحقيق الخصوصية عند طريق صلاحيات وندز حيث نمكن مستخدم من فتح مجلد ونمنع مستخدما آخر

السلام عليكم ورحمة الله وبركاته يمكنك تحويل التقرير إلى pdf ومن ثم عند الطباعة تحدد الطابعة وتحدد حجم الورقة كود التحويل إلى pdf DoCmd.OutputTo acOutputReport, ReportName, acFormatPDF, , True حيث ReportName هو اسم التقرير

مافي داعي ترفق البرنامج . هذا معناه ان النموذج الفرعي لا يحتوي على التاريخ الموجود في النموذج الرئيسي ، فالنموذج الفرعي يتم تصفيته حسب تاريخ النموذج الرئيسي ، وطبيعي ان لا ترى سجلات في النموذج الفرعي جعفر

بمرورى باحدى المنتديات وجدت هذه الطريقة للتحكم باخفاء واظهار مجلد - بحيث لا يظهر حتى مع تغير اعدادات اظهار المجلدات المخفية من خصائص المجلدات- واضافة الى ذلك وضع كلمة مرور للتمكن من اظهار المجلد مرة أخرى . والطريقة باختصار انشاء ملف txt أو notepad ثم يتم لصق هذا الكود به مع التغير باسم الفولدر وقد وضعت تحته وفوقه خط كما بالصورة وكذلك كلمة المرور وقد وضعت تحتها وفوقها خط كذلك ثم حفظ الملف بامتداد bat بعدها سيتغير شكل ملف txt الى شكل ملفات النظام والأن جرب فتح ملف bat ستلاحظ أنه يسألك هل تريد اخفاء الملف y/n طبعا y يعنى نعم قد قمت بالخطوات السابقة وأرفقت لكم ملف ال bat جاهز للاستخدام أرجو التجربة وموافاتى بالنتائج locker.rar

الف مبروك .. تستاهلون اكثر شكرا لمشرفينا الأعزاء وشكرا لإدارة الموقع

تحية طيبة للاستاذ طلعت محمد حسن اسعدني مرورك الكريم شكري وتقديري لك ولهذا المنتدى العملاق عدم ذكر كلمة المرور سهواً لدخول البرنامج:123 محرر الاكواد:251869 الشيت:1

وعليكم السلام هل النموذج الرئيسي مرتبط بالنموذج الفرعي بحقل التاريخ؟ جعفر

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

هلا سمحت لنا بمرفق حتى نتمكن من تحديد المشكلة

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

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

مبارك والى مزيد من التقدم ان شاء الله ويستهلون ويستهلون

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

الف مبروووووك لهم جميعا وبالتوفيق ان شاء الله

وهذه مساهمة مني بسيطة ما عليك إلا أن تدخل الرقم الثابت في الخلية b ثم غير الأرقام في العمود c والنتائج ستظهر تلقائيا في العمود d kh26sa.rar

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

بعد اذن اخي ياسر نفس الشيء لكن معادلات فقط مع مزيد من الخيارات Book2 salim.rar

أخي الحبيب ياسر العربي أنا بعز كل أهل الشرقية قلت ... وإنت كمان ليك معزة خاصة (وممكن نخليها خروف لو تحب أو بقرة) تقبل وافر تقديري وحبي واحترامي

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

أشكرك أستاذي الفاضل ياسر خليل والله أدعو لك ولا يعلم دعائي إلا الله

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

أخي الفاضل إبراهيم جرب الكود التالي عله يفي بالغرض Sub PopulateData() Dim Ws As Worksheet, Sh As Worksheet Dim I As Long, Col As Long Set Ws = Sheet1: Set Sh = Sheet2 Col = 1 Application.ScreenUpdating = False Sh.Range("A1").CurrentRegion.Offset(1).ClearContents With Ws For I = 2 To .Cells(Rows.Count, 1).End(xlUp).Row Step 45 .Cells(I, 1).Resize(45, 2).Copy Sh.Cells(Sh.Cells(Rows.Count, Col).End(xlUp).Row + 1, Col).PasteSpecial xlPasteValues If Col = 11 Then Col = 1 Else Col = Col + 2 Next I End With Application.CutCopyMode = False Application.ScreenUpdating = True End Sub وإليك الملف المرفق ..غيرت فقط أسماء أوراق العمل ولن يؤثر على عمل الكود Populate Data From One Column To Multiple Columns YasserKhalil.rar

وفقني الله وإياك لما فيه الخير والصلاح والحمد لله أن تم المطلوب على خير

شكرا أخي ياسر .. وفقك الله لكل خير ... وأعطاك من فضله الواسع

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

أخي الكريم يرجى تغيير اسم الظهور للغة العربية كما يرجى توضيح المطلوب أكثر .. اطلعت على الملف ووجدت أن هناك عمود للسري وعمود للدرجات في العمودين A و B ..هل تريد نسخ نفس السري ونفس الدرجات من هذين العمودين إلى بقية الأعمدة وحتى العمود L أم العمود M ..حيث أن آخر عمود هو عمود للسري؟؟؟ أم أنك تريد فقط نسخ عمود السري لبقية أعمدة السري؟؟

حياكم الله اخواني اضفت accdr للفلتر في المرفق الذي ارفقته الذي يمكن ويعطل الشفت من خارج البرنامج strFilter = ahtAddFilterItem(strFilter, "Access Files (*.mde, *.mdb, *.accdb, *.accde,*.accdr)", "*.MDE;*.MDB;*.ACCDB;*.ACCDE;.ACCDR*") البرنامج في المرفق كان يكتشف كل الامتدادات ما عدا accdr. نقول ان شاء الله ان معنى هذا انه اسلوب حماية جيد .. بالتوفيق للجميع

. نعم ، ولكن ما ادري اذا تستطيع عمله او لا 1. اذا كان برنامجك accdb مثلا ، تأكد ان النموذج الرئيسي يتم فتحه تلقائيا عند فتح البرنامج ، 2. غيّر اسم الملف من accdb الى accdr ، وبهذه الطريقة يكون الملف مُقفل اتحداك انك تقدر تعملها جعفر

جرب هذا الملف في قائمة منسدلة واحدة يتم وضع خيارين اضافة قائمة منسدلة salim.rar

جرب هذا الملف (انظر الى الورقة Sheet1) يمكن ان تبني عليه في ملفك الخاص INDEX WITH FILTER SALIM.rar

جرب هذا الملف عندك خيارين:(بخط كبير) قائمة منسدلة مطاطة(لا تذكر المكرر الا مرة واحدة ولا تحتسب الفراغات) مربع بحث حسب الحروف( او الحرف الاول) google combo.rar

تفضل الفورم بدون اشرطة الذاتية الإدارية1.rar

أخي الكريم ياسر حمزة إليك محاولة مني لعلها تفي بالغرض تم إضافة عمود مساعد للجمع بين اسم المشروع والمواد . وعلى أساس هذا العمود المساعد يتم عمل ورقة عمل لكل مادة مميزة داخل المشروع .. جرب الملف المرفق بنفسك وشوف النتائج Sub Test() Dim A, I As Long, II As Long, myList, E, X, Flg As Boolean With Sheets("الادخال").Range("A4").CurrentRegion A = .Value For I = 2 To UBound(A, 1) For Each E In Split(A(I, 13), ",") If IsEmpty(myList) Then ReDim myList(1 To 2, 1 To 1) myList(1, 1) = Trim$(E) Set myList(2, 1) = .Rows(I): X = 1 Else For II = 1 To UBound(myList, 2) If myList(1, II) = Trim$(E) Then X = II: Flg = True: Exit For End If Next If Not Flg Then ReDim Preserve myList(1 To 2, 1 To II) myList(1, II) = Trim$(E) Set myList(2, II) = .Rows(I) X = II End If End If Set myList(2, X) = Union(myList(2, X), .Rows(I)) Flg = False Next Next For II = 1 To UBound(myList, 2) If Not IsSheetExists(myList(1, II)) Then Sheets.Add(After:=Sheets(Sheets.Count)).Name = myList(1, II) .Rows(1).Copy Sheets(myList(1, II)).Cells(1) End If With Sheets(myList(1, II)) myList(2, II).Copy .Range("A" & Rows.Count).End(xlUp)(2) .Columns(13).EntireColumn.Delete .Cells(1).CurrentRegion.Columns.AutoFit End With Next End With End Sub Function IsSheetExists(ByVal txt As String) As Boolean On Error Resume Next IsSheetExists = Len(Sheets(txt).Name) On Error GoTo 0 End Function تقبل تحياتي Purchases Follow YasserKhalil.rar

بسم الله الرحمن الرحيم الاخوه الكرام اليوم بمشيئة الله سنتكلم عن المحور الخامس والاخير كيفية عمل تنسيقات للقيم المدخله فى TextBox عرفنا قبل كدا فى الشروحات السابقه ما هى اوقات تنفيذ الكود هنعمل مراجعه بسيطه لربط شرح اليوم بالشروحات السابقه قبل أن نتحدث عن وقت تنفيذ الكود لازم نعرف أولا أزاى بيكون كتابة ألاعلان عن الكود للـ TextBox Private Sub TextBox1_AfterUpdate() هنا يتم كتابة الكود المراد تنفيذه End Sub السطر الاول هو بداية الاعلان عن الكود فنقوم بكتابة Private Sub ستجد لونها بالكود أزرق ( وهو بداية لاى كود خاص لأى عنصر تحكم داخل الفورم ) ثم نقوم بكتابة اسم العنصر المراد عمل الكود له وهو بمثالنا TextBox1 ثم نقوم بكتابة _ ( تكتب من خلال الضغط على Shift+زر الطرح الموجود بالاعلى بجوار زر + ) ثم نقوم بكتابة وقت تنفيذ الكود (هو هنا على سبيل المثال AfterUpdate ) ثم كتابة () قوسين بهذا الشكل وبمجرد الضغط انتر ستجد الكود عمل سطر تانى فيه End sub يوجد طريقه اخرى وهى اتبع الصوره التالية توضح لك قم بالضغط على اى مكان فاضى بالفورم وادخل لمحرر الاكواد الخاص بالفورم هنبدأ بالامثله العمليه لان بالمثال يتضح لنا المقال وانا راجل عملى مش بحب النظرى 1-التحكم فى تنسيق القيم المدخله فى التكست بوكس بعدد صحيح شاهد الكود Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "0") End Sub السطر الاول عرفنا انه الاعلان عن الكود وسوف يتم تنفيذه فى وقت تحديث التكست بوكس أى بعد الانتهاء من الادخال والانتقال او الخروج من التكست الى اى عنصر اخر على الفورم والسطر التانى هو الكود اللى هيتم تنفيذه شرح الكود ( السطر التانى ) شاهد الصوره هنا نوع التنسيق "0" تم وضعه بين علامتين تنصيص وبداخله 0 يعنى تنسيق التكست بوكس بعد الادخال يكون رقم صحيح فلو فرضنا حضرتك كتبت 20.60 وخرجت من التكست بوكس ستجد القيمة اصبحت 20 فقط ولا يوجد علامه عشريه -------------------------------------------------------------------------------------------------------------------------------------------------------- 2-التحكم فى تنسيق القيم المدخله فى التكست بوكس بوضع علامه عشريه Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "0.0") End Sub هنا نوع التنسيق "0.0" يكون رقم واحد بعد العلامه العشريه مثال لو حضرتك ادخلت 20 فقط ستجد التكست بوكس اصبح 20.0 ولو حضرتك دخلت 20.2 ستجد التكست بوكس اصبح 20.2 ولو حضرتك دخلت 20.50 ستجد التكست بوكس اصبح 20.5 فقط يعنى سوا دخلت رقم عشري واحد او ادخلت رقمين عشريين او لم تدخل ارقام عشريه ستجد النتيجة بعد رقم عشرى واحد طيب لو احنا عايزين رقمين بعد العلامه العشريه الموضوع بسيط جدا هنخلى التنسيق كالتالى "0.00" شاهد الكود Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "0.00") End Sub لاحظتم الفرق طيب لو 3 أرقام عشريه Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "0.000") End Sub ------------------------------------------------------------------------------------------------------------------------------------ 3-التحكم فى تنسيق القيم المدخله بوضع علامه العمله $ Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "0" & "$") End Sub هنا تم "0" ( وهو تنسيق رقم صحيح) ثم علامه & ( تكتب من خلال الضغط على Shift+رقم 7 فوق الحروف ) ثم ثم وضع علامه العمله "$" بين اقواس تنصيص فلو حضرتك كتبت 20 ستجد $20 واحد هيقولى هو مش ممكن يكون العلامه يسار الرقم وليس يمين الرقم هقوله ممكن وليه لا هنعكس الموضوع بدل "$"&"0" هنخليها "0"&"$" Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "$" & "0") End Sub فلو حضرتك كتبت 20 ستجد النتيجة 20$ طيب ممكن نخلى علامه العمله وكمان وجود ارقام عشريه طبعا ممكن Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "$" & "0.00") End Sub فلو حضرتك كتبت 20.1 ستجد النتيجة 20.10$ ---------------------------------------------------------------------------------------------------------- 4-التحكم فى تنسيق القيم المدخله بوضع نص بجوار الرقم Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "0" & "ريال") End Sub هنا تم كتابه النص بين علامتى تنصيص " ريال" فلو حضرتك كتبت 20 ستجد النتجية 20 ريال -------------------------------------------------------------------------------------------------------------------- 5-التحكم فى تنسيق القيم المدخله بوضع علامه % Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "%0") End Sub فلو حضرتك كتبت 20 ستجد النتيجة %20 ( اذا كانت لغة الكتابه بالكيبورد عربى ) أما اذا كانت لغة الكتابة انجليزى وكتبت رقم 20 ستجد النتيجة 20% فمن خلال لغة الكتابه بالكيبورد تقدر تتحكم فى مكان العلامه % هل تكون قبل الرقم أم بعده واحد هيقولى هو ممكن نجعل الرقم بعلامات عشريه مع وجود علامه % هقوله ليه بس الاحراج يا عبدالتواب شوف يا سيدى الكود التالى Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "%0.00") End Sub فلو حضرتك كتب 20.1 ستجد النتيجة 20.10% ---------------------------------------------------------------------------------------------------------------------------------------- 6-التحكم فى القيم المدخله اذا كانت سالبه توضع بين اقواس Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "0;(0)") End Sub فلو حضرتك كتبت -50 ستجد النتجية (50) يعنى تحول اى رقم سالب الى بين اقواس طيب لو كان الرقم السالب فيه علامات عشريه شاهد الكود ولاحظ الفرق البسيط Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "0;(0.00)") End Sub مثال لو حضرتك كتبت-20.1 ستجد النتيجة (20.10) -------------------------------------------------------------------------------------------------------------------- 7-التحكم فى القيم المدخله اذا كانت تاريخ لو حضرتك عايز تكتب تاريخ وليكن 2015/8/6 وعايز بعد الادخال يظهر فقط اليوم Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "dd") End Sub ستجد ان النتيجه 6 dd تشير الى Day يعنى اليوم **************************************************************************** لو انا عايز النتيجة 6 اللى هى اليوم تظهر فى التكست بوكس 2 ( TextBox2) Private Sub TextBox1_AfterUpdate() TextBox2.Text = Format(TextBox1.Text, "dd") End Sub فلو حضرتك كتبت التاريخ 2015/8/6 فى التكست بوكس 1 ستجد التكست بوكس 2 مكتوب فيه 6 ************************************************************************************************ لو عايزين نظهر الشهر فقط هنستبدل dd بـ mm وهى اختصار لكلمة (Month) Private Sub TextBox1_AfterUpdate() TextBox2.Text = Format(TextBox1.Text, "mm") End Sub ستجد النتجية ظاهره فى التكست بوكس 2 وهى 8 ************************************************************************************** لو عايزين نظهر السنه. هنستبدل mm بـ yyyy وهى اختصار Year Private Sub TextBox1_AfterUpdate() TextBox2.Text = Format(TextBox1.Text, "yyyy") End Sub ستجد النتيجة فى التكست بوكس 2 هى 2015 ***************************************************************************************** لو عايزين نظهر اليوم كتابه 06-08-2015 يطلع فقط الخميس Private Sub TextBox1_AfterUpdate() TextBox2.Text = Format(TextBox1.Text, "dddd") End Sub ستجد النتيجة فى التكست بوكس 2 هى الخميس ********************************************************************************** لو عايزين نظهر الشهر 06-08-2015 يظهر فقط اغسطس Private Sub TextBox1_AfterUpdate() TextBox2.Text = Format(TextBox1.Text, "mmmm") End Sub ستجد النتيجة هى اغسطس ********************************************************************** لو عايزين ننسق التاريخ المدخل يكون كالتالى 06/08/2015 Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "dd/mm/yyyy") End Sub ****************************************** لو عايزين ننسق التاريخ المدخل يكون كالتالى2015/08/06 شوف الكود Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "yyyy/mm/dd") End Sub ****************************************** لو عايزين ننسق التاريخ المدخل يكون كالتالى06-08-2015 يعنى يكون العلامه بدل من / تكون - Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "yyyy-mm-dd") End Sub ****************************************** لو عايزين نجعل التاريخ كالتالى 06-08-15 ( يعنى أظهار السنه رقمين فقط Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "yy-mm-dd") End Sub هنا خلينا السنه بدل من yyyy الى yy فقط ****************************************** لو عايزين ننسق التاريخ كدا 06 أغسطس2015 Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "dd mmmm yyyy") End Sub ****************************************** لو عايزين نخلى التاريخ يظهر كالتالى الخميس أغسطس 2015 Private Sub TextBox1_AfterUpdate() TextBox1.Text = Format(TextBox1.Text, "dddd mmmm yyyy") End Sub ****************************************** لوعايزين نظهر تاريخ اليوم بمجرد وضع مؤشر الماوس فى التكست بوكس Private Sub TextBox1_Enter() TextBox1.Text = Format(Now, "yyyy/mm/dd") End Sub هنا استخدمنا وقت التنفيذ الحدث Enter ****************************************** 8-التحكم فى أجبار المستخدم على ادخال ارقام فقط فى التكست بوكس Private Sub TextBox1_Change() If Not IsNumeric(Me.TextBox1.Value) Then: MsgBox " الرجاء ادخال أرقام فقط ", vbCritical, "خطأ": Me.TextBox1.Value = "": Exit Sub End Sub هنا عملنا كود فى حدث التغيير للتكست بوكس بمجرد كتابة اى حرف وليس رقم ستجد التكست بوكس يرفض الادخال ويقوم بمسح المحتوى اللى تم ادخاله وكمان يظهر رساله استخدمنا فى الكود IF Not IsNumeric ثم التكست المراد ادخال ارقام فقط ووضعه بين قوسين ثم اقفال IF بـ then ****************************************** 9-التحكم فى أجبار المستخدم على ادخال حروف فقط فى التكست بوكس نفس الكود السابق ولكن بدون Not Private Sub TextBox1_Change() If IsNumeric(Me.TextBox1.Value) Then: MsgBox " الرجاء ادخال حروف فقط ", vbCritical, "خطأ": Me.TextBox1.Value = "": Exit Sub End Sub ****************************************** **************************************************************************** ******************************************************** ************************************** الى هنا بحمد الله انتهيت من شرح الخمس محاور المتعلقه بالتكست بوكس والى لقاء اخر من حلقات علمنى كيف اصطاد وسيكون بأذن الله الكمبوبوكس

الأخ الكريم صلاح الدين سعيد مبروك عليك الاسم الجديد إليك الكود التالي عله يكون المطلوب Sub MyReport() Dim SN, I As Long, J As Long, N As Long Sheets("إجمالي").Range("A1:B1000").ClearContents SN = Sheets("إدخال").Range("H1:AU" & Sheets("إدخال").Cells(Rows.Count, 8).End(xlUp).Row) ReDim Arr(UBound(SN) * UBound(SN, 2), 2) For I = 2 To UBound(SN) For J = 1 To UBound(SN, 2) Step 2 If SN(I, J) <> "" Then Arr(N, 0) = SN(I, J) Arr(N, 1) = SN(I, J + 1) N = N + 1 End If Next J Next I With Sheets("إجمالي") .Cells(2, 1).Resize(N, 2) = Arr .Cells(1, 1) = "اسم الصنف": .Cells(1, 2) = "الكمية المنصرفة" End With End Sub يرجى إذا كان فيه طلب جديد طرح موضوع جديد ..ليكون كل موضوع بطلب مستقل .. هذا لأن طلبك الثاني مختلف عن الأول (لكن عشان جديد وعشان سمعت الكلام وغيرت اسمك للغة العربية .. محبتش أتقل عليك) لا تنسى الالتزام بالتوجيهات على هذا الرابط (من هنا) ، وتحديد أفضل إجابة ليظهر الموضوع مجاب ومنتهي تقبل تحياتي Recipe YasserKhalil.rar

تابع الشرح انتهى الشرح ارجو ان يكون هذا العمل خالصا لوجه الله تعالى وَقُلْ رَبِّ زِدْنِي عِلْمًا

السلام عليكم ... ومن أجل حفظ الصفحة بدون ارتباطات مع الملف الأساسي إليك الكود التالي: Public NewWorkbok As Object Sub SaveSheet() Dim MyPath As String Dim NumberSheets() As Integer MyPath = Workbooks("MAH").Path & "\MAH_TEST" Set NewWorkbok = Workbooks.Add Workbooks("MAH").Sheets(1).Copy Before:=Workbooks(NewWorkbok.Name).Sheets(1) ReDim NumberSheets(2 To NewWorkbok.Worksheets.Count) For i = 2 To NewWorkbok.Worksheets.Count NumberSheets(i) = i Next i Application.DisplayAlerts = False With NewWorkbok .Sheets(NumberSheets).Delete .Sheets(1).Cells.Copy .Sheets(1).Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False .Sheets(1).Cells(1, 1).Select .SaveAs Filename:=MyPath .Close End With Application.DisplayAlerts = True End Sub