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

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

السلام عليكم برنامج مخازن مجرب ومباع في الكويت لكبرى الشركات والمؤسسات به كل ما يتمناه اي مسئول مخزن سهل الاستخدام قوي النتائج ملحوظة : كلمة المرور في البرنامج هي 1234 ملحوظة : لاضافة اي معلومة داخل اي صندوق فقط النقر مرتين بالماوس علي الصندوق لفتح شاشة الادخال الخاصة به وبعدها تجد ما اضفته موجود بالصندوق ملحوظة : البرنامج مصمم علي اكسيس 97 وانا في الطريق لعمل نسخة لباقي اصدارات الاكسيس ارجو ان يفيدكم ولا تنسونا بالدعاء اخوكم علي عبد الحميد - الكويت Str.zip

القصد انه يمكننا عند فتح البرنامج فك التشفير لتمكين الربط وهذه اكواد لتطبيق فكرة ابو عبدالله من داخل اكسس الحدث الاول للتشفير والآخر لفك التشفير Dim FilePath As String Private Sub Command1_Click() On Error Resume Next FilePath = CurrentProject.path & "\folderName" Name FilePath As FilePath & ".{208D2C60-3AEA-1069-A2D7-08002B30309D}" End Sub Private Sub Command2_Click() On Error Resume Next FilePath = CurrentProject.path & "\folderName" Name FilePath & ".{208D2C60-3AEA-1069-A2D7-08002B30309D}" As FilePath End Sub وهذه زيادة معلومات نسختها من المصدر نفسه بسم الله الرحمن الرحيم هذه طريقة لتشفير الفولدر وإخفاء كل مابداخله من ملفات طبعا الطريقة تعمد على تغيير لاحقة الفولدر برمز من رموز أيقونات الويندوز المتعارف عليها مثل ايقونة الشبكات او جهاز الكمبيوتر أو سلة المهملات وهذه قائمة برموز تلك الايقونات بالإمكان تغييرها في كود البرنامج وسيتم التشفير على ذلك الاساس .. مع قبول تحياتي {0DF44EAA-FF21-4412-828E-260A8728E7F1} Task Bar & Start Menu {1f4de370-d627-11d1-ba4f-00a0c91eedba} Search Folder {208D2C60-3AEA-1069-A2D7-08002B30309D} My Network Places {20D04FE0-3AEA-1069-A2D8-08002B30309D} My Computer {21EC2020-3AEA-1069-A2DD-08002B30309D} Control Panel {2227A280-3AEA-1069-A2DE-08002B30309D} Printers & Faxes {2559a1f4-21d7-11d4-bdaf-00c04f60b9f0} Internet Explorer {2559a1f5-21d7-11d4-bdaf-00c04f60b9f0} Outlook {450D8FBA-AD25-11D0-98A8-0800361B1103} My Documents {645FF040-5081-101B-9F08-00AA002F954E} Recycle Bin {6DFD7C5C-2451-11d3-A299-00C04F8EF6AF} Folder Options {7007ACC7-3202-11D1-AAD2-00805FC1270E} Network Conections {85BBD920-42A0-1069-A2E4-08002B30309D} Briefcase {871C5380-42A0-1069-A2EA-08002B30309D} Internet Explorer {992CFFA0-F557-101A-88EC-00DD010CCC48} Dial-Up Networking {D4480A50-BA28-11d1-8E75-00C04FA31A86} Add Network Place {D6277990-4C6A-11CF-8D87-00AA0060F5BF} Scheduled Tasks {E211B736-43FD-11D1-9EFB-0000F8757FCD} Scanner & Camera أخوكم اكسيرالحياة الاثنين 27 ربيع الاول 1428 الموافق 16 إبريل 2007

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

شكرا جزيلا لك أخي ياسر وفقكم الله لكل خير

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

اسطوانة تعليم الاطفال القران الكريم الجزء 27 قال فما خطبكم الاسطوانة على الرابط التالى اضغط هنا

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

في اوفس 2007 اذهب الى تخطيط الصفحة ثم اختر طباعة العناوين يظهر لك اطار جديد ثم رأس / تذييل الصفحة ثم اختر راس او تذييل مخصص وضع ما تريد

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

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

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

اشكرك اخوي سعيد .. لما ذكرت لي فكرة الجدول حللت المشكلة بشكل جذري .. انظر للمرفق الان ShowButton1.zip

السلام عليكم ورحمة الله أخي الحبيب أبو حنين، تم التعديل على معادلات الاستدعاء في شيت "تصفية" حسب المطلوب... وكان الخلل في جزئية الدالة MATCH التي تعين رقم صف رقم الترتيب (من 1 إلى ...) من العمود C كله من شيت "عام" أي بداية من الصف الأول، غير أن نطاق جلب البيانات بالدالة INDEX هو النطاق المسمى Plage الذي يبدأ من الصف الخامس (الذي يعتبر الصف الأول) لذا كان من اللازم حذف 4 من الرقم الذي تعطيه الدالة MATCH وتم التعديل على المعادلات على هذا الأساس... أما بالنسبة للتصفية على C1 لم أجد أي مشكل فيها وهي تعمل على أحسن وجه... والله أعلم تم رفع الملف على الموقع نفسه حتى يتسنى لك تحميله بسهولة وكما تريد... أخوك بن علية رابط الملف المعدل

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

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

تفضل بتجربة الروابط الاتية https://userscloud.com/vecg3lcikn1w او هذا الرابط http://www.4shared.com/zip/H22iSPYoce/Microsoft_Office_Enterprise_20.html Password: samimomin.blogspot.com

أخي الحبيب عبد العزيز المدني عدلت في الكود بشكل كبير بحيث يكون مرن وتستطيع التعديل عليه بكل سهولة كل ما عليك هو التعديل في الأسطر التي تلي التعليقات .. السطر الأول خاص بصف البداية أي أول صف يحتوي على بداية الأسماء والتعديل الثاني هو رقم العمود الموجود فيه الأسماء ..اكتب رقم العمود فإذا كان العمود هو العمود J ستكتب 10 أرجو أن يكون التعديل مناسب لك Sub PopulateFullNamesToAdjacentColumns() Dim I As Long, strName As String 'Row Number Where Names Start Const Row As Long = 2 'Column Number Where Names Exist >> 1 For A - 2 For B - 3 For C ... Const Col As Long = 2 For I = Row To Cells(Rows.Count, Col).End(xlUp).Row strName = Cells(I, Col).Value If Kh_Names(strName, 1) = strName Then Cells(I, Col + 1) = Kh_Names(strName, 1) ElseIf Kh_Names(strName, 1, 2) = strName Then Cells(I, Col + 1) = Kh_Names(strName, 1) Cells(I, Col + 5) = Kh_Names(strName, 2) ElseIf Kh_Names(strName, 1, 2, 3) = strName Then Cells(I, Col + 1) = Kh_Names(strName, 1) Cells(I, Col + 2) = Kh_Names(strName, 2) Cells(I, Col + 5) = Kh_Names(strName, 3) ElseIf Kh_Names(strName, 1, 2, 3, 4) = strName Then Cells(I, Col + 1) = Kh_Names(strName, 1) Cells(I, Col + 2) = Kh_Names(strName, 2) Cells(I, Col + 3) = Kh_Names(strName, 3) Cells(I, Col + 5) = Kh_Names(strName, 4) ElseIf Kh_Names(strName, 1, 2, 3, 4, 5) = strName Then Cells(I, Col + 1) = Kh_Names(strName, 1) Cells(I, Col + 2) = Kh_Names(strName, 2) Cells(I, Col + 3) = Kh_Names(strName, 3) Cells(I, Col + 4) = Kh_Names(strName, 4) Cells(I, Col + 5) = Kh_Names(strName, 5) Else Cells(I, Col + 1) = Kh_Names(strName, 1) Cells(I, Col + 2) = Kh_Names(strName, 2) Cells(I, Col + 3) = Kh_Names(strName, 3) Cells(I, Col + 4) = Kh_Names(strName, 4) Cells(I, Col + 5) = Kh_Names(strName, 5) End If Next I End Sub Function Kh_Names(FullName As String, ParamArray Index1()) As String Dim I As Integer Dim Kh_Split, MyArray, Arr Dim Kh_String As String, SN As String, RE As String On Error GoTo Err_Kh_Names MyArray = Array("عبد ", "أبو ", "ابو ", "آل ", " الله", " الدين", " الإسلام", " الاسلام", " الحق", " النصر", " العهد", " النور", " بالله", "زين ") SN = Application.WorksheetFunction.Trim(FullName) For Each Arr In MyArray RE = Replace(Arr, " ", "^") SN = Replace(SN, Arr, RE) Next Kh_Split = Split(SN, " ", , vbTextCompare) On Error Resume Next For I = 0 To UBound(Index1) Kh_String = Kh_String & " " & Kh_Split(Index1(I) - 1) Next On Error GoTo 0 Kh_String = Replace(Trim(Kh_String), "^", " ") Kh_Names = Kh_String Exit Function Err_Kh_Names: Kh_Names = "" End Function تقبل تحياتي Populate Full Names To Adjacent Columns YasserKhalil.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

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

السلام عليكم ... ومن أجل حفظ الصفحة بدون ارتباطات مع الملف الأساسي إليك الكود التالي: 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