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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

ما هي الدوال : الدوال هي أسماء محجوزة ومعرفة من قبل الفيجوال بيسك لتقوم بعمل معين مثل المصفوفات والقيم المطلقة وغيرها .. أو بمعني ابسط واعم هي عبارة عن برنامج صغير مكتوب مسبقا و محفوظ داخل لغة الفيجول بيسك يمكن استدعاءه من خلال برنامجك والاستفادة منه ، إضافة إلى ذلك يمكنك أنت أن تكتب دالة وتستدعيها أكثر من مرة داخل برنامجك . والدوال في الفيجول بيسك تنقسم إلى: 1. الدوال الرياضية . Mathematics Functions 2. دوال سلاسل البيانات . String Functions 3. دوال الوقت و التاريخ Date and Time Functions 4. دوال التحقق من أنواع البيانات Data Type Inspection Functions 5. دوال المدخلات و المخرجات Program Output and User Input Functions 6. دوال مالية Financial Functions 7. دوال التحويلات Conversion Function 8. دوال التعامل مع الفهارس 9. دوال التعامل مع الملفات 10. دوال المصفوفات 11. و دوال متنوعة أخري 12. دوال معرفة من قبل المبرمج. User Defined Functions ( UDF ) ونلاحظ أن نوع الدوال من رقم (1) حتى رقم (7) أنها دوال داخلية ضمن اللغة، أي تأتي مُعرفة في لغة الفيجول بيسك و مبرمجة مسبقاً لكي تستخدمها مباشرة.ً أما النوع الأخير فيتم تعريفه بواسطة المبرمج، أي بواسطتك أنت. 1. الدوال الرياضية . Mathematics Functions الدالة Abs : ترجع القيمة المطلقة لآي عدد وترجعه من نفس نوع البيانات المعطى للدالة والمقصود بالقيمة المطلقة هي قيمة العدد بدون إشارة فالقيمة المطلقة ل (-13) مثلا هي (13) وهكذا, فمثلا لو كتبنا الكود التالي كود: MyNumber=Abs(-45.6) Text1.Text=MyNumber فإن نتيجة تنفيذ الدالة هي MyNumber=45.6 ولاحظ أن القيمة المدخلة للدالة لابد أن تكون عدد أو تعبير عددي فإذا كانت القيمة المدخلة للدالة Null ستكون النتيجة Null وإذا كانت القيمة المدخلة للدالة متغير فارغ أو لم يتم تعيين قيمة له ستكون النتيجة (0). الدالة Sqr : تستخدم هذه الدالة في تحديد الجذر التربيعي لرقم معين وتأخذ الصورة العامة التالية . كود: MyNumber=Sqr(10) Text1.Text=MyNumber فإن نتيجة تنفيذ الدالة هي MyNumber=3.1622776 الدالة Log : تستخدم هذه الدالة في تحديد قيمة اللوغاريتم العشري لرقم وتأخذ الصورة العامة التالية : كود: MyNumber=Log (20)Text1.Text=MyNumber فإن نتيجة تنفيذ الدالة هي MyNumber=2.9957327 الدالة Exp : تستخدم هذه الدالة في تحديد القيمة (e) وهي قاعدة اللوغاريتم الطبيعي مرفوعة بقوة الرقم الذي تتضمنه حيث (e) تساوي تقريبا 2.7182818 وتأخذ الصورة العامة التالية : كود: MyNumber=Exp (رقم) الدالة Rnd : : وتستخدم هذا الدالة في توليد أرقام عشوائية تقع ما بين الصفر و واحد بحد أقصي 15 رقما عشريا وتأخذ الصورة العامة التالية : كود: MyNumber=Rnd (عدد) فمثلا الدالة Rnd(10) قد تعطي رقما مثل 0.7055475 وعند تشغيل الدالة مرة أخري ينتج رقما آخر مثل 0.533424 وهكذا . التصريح Randomize : يعمل هذا التصريح مع الدالة Rnd ونستفيد منه عدم التكرارية و الحصول علي عشوائية افضل وذلك لأنه يعتمد علي ساعة النظام لديك . ويأخذ الصورة التالية . كود: RandomizeMsgBox Int((10 * Rnd) + 1( وهنا نعمل علي توليد أرقام عشوائية من واحد إلى عشرة . أما إذا أردت أن تجعل هذه العشوائية نصوص وليس أرقاما فلك طريقتين لتحايل علي هذا أما أن تضع النصوص في قاعدة بيانات وفي شكل سجلات وتعضي لكل سجل رقم أو تضعه في مصفوفة وتعضي لكل نص رقم أيضا وأنا افضل الطريقة الأولى لسرعتها الدالة Int : : وتستخدم هذه الدالة لحساب الجزء الصحيح فقط من رقم يشتمل علي أرقام صحيحة وعشرية أو بعبارة أخر لحذف الأرقام العشرية الموجودة بعد العلامة العشرية بدون تقريب وتأخذ الصورة التالية : كود: MyNumber=Int (332.54) فإن نتيجة تنفيذ الدالة هي MyNumber=332 الدالة Atn : : تستخدم هذه الدالة في حساب مقلوب ظل الزاوية "ظتا" للرقم الذي تشتمل علية مقدار بالتقدير الدائري وتأخذ الصورة العامة التالية : كود: MyNumber=Atn (رقم) الدالة Tan : : تستخدم هذه الدالة في تحديد قيمة ظل زاوية معينة وتأخذ الصورة العامة التالية : كود: MyNumber=Tan (رقم) الدالة Cos : : وتستخدم هذه الدالة في تحديد قيمة جيب تمام الزاوية معينة وتأخذ الصورة العامة التالية : كود: MyNumber=Cos (رقم) الدالة Sin : تستخدم هذه الدالة في تحديد قيمة جيب زاوية معينة وتأخذ الصورة العامة التالية : كود: MyNumber=Sin (رقم) الدالة Round : وهي دالة التقريب التي من خلالها يمكنك تحديد عدد الأرقام العشرية وتأخذ الصورة التالية : كود: MyNumber= Round(4.52696,2) حيث 4.52696 الرقم المراد تقريبه أما الرقم 2 فهو عدد التي ستقرب بعد العلامة العشرية وسيكون الناتج 4.53 الدالة Fix : وهي تشبه الدالة Int تماما أي أنها تستخدم لحساب الجزء الصحيح فقط وتأخذ الصورة التالية : كود: MyNumber= Fix(4.52696) فإن نتيجة تنفيذ الدالة هي MyNumber=4 دوال سلاسل البيانات . String Functions الدالة Array : تحول عدة بيانات مدخلة كنصوص تفصلها فاصلة إلى مصفوفة يكون رقم أول عنصر فيها (Lower Bound) هو (0) فمثلا لو أدخلنا النص التالي إلى الدالة . كود: "Frist","Second","Third","Forth" MyNumber= Array("First" , "Second" , "Third" , "Forth" )Print MyNumber(0)Print MyNumber(1)Print MyNumber(2)Print MyNumber(3) نرى أن النتيجة هي كود: FirstSecondThirdForth أي أن المتغير MyNumber يحمل مصفوفة ممتلئة بالنصوص المدخلة بعد أن تحولت إلى عناصر للمصفوفة لاحظ أن المتغير MyNumber كان من نوع Variant لأننا لم نعلن عنه ويمكن للمتغير من هذا النوع أن يحمل مصفوفة وكذلك يمكن أن تكون المصفوفة من أي نوع آخر فالمصفوفة المستعملة في المثال هي مصفوفة نصية بينما لو كانت العناصر المدخلة أرقما (لاستعملنا علامات التنصيص مع الأرقام حتى لا تعتبر نصوصا) لكانت مصفوفة من نوع Integer مثلا . الدالة Asc : ترجع كود الرمز المدخل (ASCII Code) فمثلا الحرف A له الكود 65 فعند إدخال حرف A مثلا ستكون النتيجة 65 وهكذا ( لاحظ أن حرف A يختلف عن حرف a في الكود) . كود: MyNumber = Asc("a") تجد أن المتغير MyNumber أصبح يحمل القيمة 97 . وهكذا .. انتبه فيما لو غيرة الحرف من صغير إلى كبير ستتغير القيمة إلى 65 الدالة UCase : وظيفتها بسيطة جدا فهي ببساطة تحول حالة النص المدخل من حالة الأحرف الصغيرة (Small Letters) إلى حالة الأحرف الكبيرة (Capital Letters) فالمثال التالي يحول "taftaf1267" إلى "TAFTAF1267” كود: Ucase("taftaf1267") الدالة LCase : تعيد الدالة LCase نسخة من النص string تكون فيه جميع الحروف صغيرة Lowercase المتغيرة myText في المثال التالي ستحتوي على عبارة it works : كود: myText = "It Works"myText = LCase(myText) الدالة chr : تقوم الدالة chr بأخذ قيمة بين 0 و 255 وتعيد الحرف الممثل لهذه القيمة في جدول رموز ASCII، على سبيل المثال العبارة التالية : كود: Hi,I'm "Asihy" ستجد أنك لا تستطيع كتابتها بهذا الشكل : كود: myText = "Hi," & vbCrLf & "I'm "Asihy"" لأن البرنامج سيعتقد بأن نهاية السلسة النصية السابقة هي عند علامات الاقتباس التي تقع مباشرة قبل كلمة Asihy وستظهر لك رسالة خطأ، لذلك فإننا نلجأ لاستخدام الدالة chr حيث أن رمز علامة الاقتباس المزدوجة في جدول ASCII هو 34، فتكون الصياغة الصحيحة للعبارة البرمجية السابقة كالتالي : كود: myText = "Hi," & vbCrLf & "I'm " & chr(34) & "TafTaf" & chr(34 ) الدالة Len : ستجد فيما بعد حاجة في كثير من الأحيان لمعرفة طول السلسلة النصية ( عدد الأحرف )، ولعمل ذلك استخدم الدالة Len، مرر إليها النص وستعيد لك عدد الحروف. كود: myLength = Len("TafTaf") الدالة InStr : يمكنك بواسطة هذه الدالة معرفة أول مكان يظهر فيه نص ما ضمن نص آخر أكبر منه. الوسيطة الأولى هي وسيطة اختيارية تحدد مكان بدء البحث، أما الوسيطة الثانية string1 فتحدد السلسلة النصية التي سيتم البحث فيها، والوسيطة الثالثة string2 تحدد السلسلة النصية التي سيتم البحث عنها في السلسلة الأولى، أما الوسيطة الأخيرة فهي اختيارية أيضا وتحدد نوع المقارنة التي يجب إجرائها وهي تأخذ أحد الثوابت التالية : 0 - vbBinaryCompare 1 - vbTextCompare والفرق بينهما هو أن الأولى تراعي حالة الأحرف والثاني لا تراعي حالة الأحرف. في المثال التالي الدالة i ستحتوي على القيمة 1 : كود: i = InStr("TafTaf","T") وأما المثال التالي فستحتوي i فيه على القيمة 3 : كود: i = InStr("aafTaf","T") حيث أن الدالة في المثال السابق ستبحث عن الحرف T بادئه من الحرف الثاني ولذلك فهي لن تجد الحرف الأول. الدالة InStrRev : : وهي شبيهه بدالة InStr ( وقد سبق شرحها من قبل ) ولكن تكون عملية البحث عن الحرف عكسية أي تبدأ من نهاية القيمة . وهي حساسة لحالة الأحرف وتأخذ الصورة التالية : كود: Print InStrRev("Mostafa", "a”)Print InStr("Mostafa", "a") بالنسبة للحالة الأولى سيكون الناتج رقم 7 لأنها تبدأ من نهاية القيمة . أما في الحالة الثانية فسيكون الناتج 5 لأنها تبدأ من بداية القيمة . الدالة Str : قد تبدو الدالة Str متشابهة مع الدالة chr، إلا أنها تؤدي وظيفة مختلف تماما، فهي تحول الأرقام إلى سلاسل نصية، وهي تفيد مثلا في حال أردت أن تقوم بالتحام بين رقمين فتقوم بتحويل كل منهما إلى سلسلة نصية وتطبق بينهما جمع السلاسل ( & ) الذي يختلف عن جمع الأرقام وبالتالي تحصل على سلسلة جديدة يمكنك أن تحولها إلى رقم من جديد، على سبيل المثال الدالة myNumber تحتوي على القيمة 123456. كود: myNumber = Str(123) & Str(456) ستواجهك مشكلة في الشفرة السابقة حيث يقوم فبجوال بيسيك بإضافة مسافة قبل كل سلسلة نصية تنتج من الدالة السابقة. الدالة Val : وهي تحول السلاسل النصية إلى قيمة رقمية وهي عكس الدالة Str() التي تحول الأرقام إلى سلاسل نصية وتأخذ الصورة التالية : كود: myNumber = Val (Text1.text) وهنا تعمل الدالة علي تحويل القيمة الموجودة في Text1 إلى قيمة رقمية . الدالة Left : حيث تقوم بوضع سلسلة نصية string وتحدد الجزء الذي تريد اقتطاعه من بداية السلسلة length، والتعبير بكلمة من بداية السلسلة أدق من يسار السلسلة لأن هذا قد يحدث اشتباها في السلاسل النصية للغات التي تكتب من اليمين إلى اليسار مثل العربية، هنا تعيد السلسلة العدد المحدد من الحروف من اليمين أي أنها لا تهتم لاتجاه ظهور أحرف السلسة وإنما اتجاه تخزينها، وللتخلص من هذه المشكلة سنقول بداية السلسلة . الدالة Right : : مطابقة للدالة Left في كل شيء، إلا أنها تأخذ العدد المحدد من الحروف من نهاية السلسلة. الدالة Mid : : تعيد الدالة Mid عددا من الأحرف قدره length بدءا من حرف معين هو start، في سلسلة نصية string لاحظ أيضا أن الوسيطة length اختيارية وإذا لم تمرر بها أي قيمة فإن الدالة ستعيد الأحرف إلى نهاية السلسلة . في المثال التالي ستحتوي المتغيرة myText على العبارة I'm Taf : كود: myText = Mid("I'm TafTaf", 1, 7) أما في المثال التالي فستحتوي على الكلمة TafTaf : كود: myText = Mid("I'm TafTaf", 5) التصريح Mid : : يقوم التصريح Mid باستبدال مقطع محدد من النص بنص آخر، وهو يكتب في صورة مشابهة جدا لطريقة كتابة دالة Mid ولكن توضع بعده علامة مساواة وبعدها العبارة الجديدة، في المثال التالي ستحتوي المتغيرة myText على القيمة I'm Asihy : كود: name = "Asihy"myText = "I'm name"Mid(myText, 5) = name حيث سيتم حذف الجزء المحدد بالخاصية Mid ويوضع الجزء الذي بعد علامة المساواة في مكان الجزء المحذوف . الدالة strReverse : تعيد السلسلة string معكوسة، أي تبدأ من البداية وتنتهي من النهاية، المتغيرة myText في المثال التالي ستحتوي على العبارة emoclew : كود: myText = strReverse("welcome") الدالة Replace : وتقوم باستبدال النص string2 بالنص string3 ضمن السلسلة string1، أي أنها تبحث فبالنص string1 عن النص string2 وعندما تجده فإنها تحذفه منه وتضع مكانه string3، ويمكن تحديد نقطة بداية البحث بالوسيطة start، وعدد مرات الاستبدال القصوى بالوسيطة count، ضع القيمة -1 لاستبدال الكل، وطريقة المقارنة بالوسيطة compare كما ذكر سابقا. المتغيرة myText في المثال التالي ستحتوي على القيمة Hi Everyone : كود: myText = Replace("Welcome Everyone,", "Welcome", "Hi", 1, -1) الدالة Format : وتقوم هذه الدالة بتنسيق رقم أو سلسلة حروف أو التاريخ/الوقت الموجود في التعبير تبعا لتعليمات التنسيق الموجودة في الدالة نفسها . وتأخذ الصورة التالية : كود: MyDate = Format(Date, "dd-mmm-yyyy")Text1.Text = MyDate الدالة Trim : تقوم هذه الدالة بحذف الفراغات الموجودة في الجهة اليسري و اليمني من سلسلة وتأخذ الصورة التالية : كود: MyText = Trim(" TafTaf ")Text1.Text = MyText الدالة Rtrim : تقوم هذه الد الة بحذف الفراغات الموجودة في الجهة اليمني من سلسلة وتأخذ الصورة التالية : كود: MyText = Rtrim("TafTaf ") الدالة Ltrim : وتقوم هذه الدالة بحذف الفراغات الموجودة في الجهة اليسري و اليمني من سلسلة . وتأخذ الصورة التالية : كود: MyText = Ltrim(" TafTaf ") الدالة Space : وتقوم هذه الدالة سلسلة فراغات محدده بالعدد الموجود بين الأقواس كود: MyText ="I'm"+Space (2)+"TafTaf" الدالة StrComp : تقارن سلسلتين لتحدد هل هما متساويتين ثم تعيد رقما بنتيجة المقارنة وتأخذ الصورة العامة التالية : كود: MyText =StrComp("TafTaf","TafTaf") الدالة Ascw : وهي عكس الدالة Asc فالدالة Ascw ترجع كود الرمز المدخل إلى الترميز Unicode وتأخذ الصورة التالية : كود: MsgBox Ascw("ت") الدالة Chrw : وهي عكس الدالة Chr تعيد الحرف الممثل لهذه القيمة في الترميز Unicode وتأخذ الصورة التالية : كود: MsgBox ChrW(1578( توضيح اكثر للدوال الأربع : كود: Private Sub Command1_Click()MsgBox Asc("ت")MsgBox AscW("ت")MsgBox Chr(202(MsgBox ChrW(1578)End Sub الدالة String : وتعمل هذه الدالة علي تكرار الحرف المار أليها وناجذ الصورة التالية . كود: MyString = String(10, "T") MsgBox MyString هنا عملنا علي تكرار حرف T عشر مرات . كود: mystring = String(2, 13)ss = "Welcome To V.B World" & mystring & "Welcome To V.B World"MsgBox ss وفي هذا المثال عملنا علي تكرار الضر علي مفتاح الإدخال والذي يرمز له برمز (13) في جدول اسكي مرتان . [ دوال الوقت و التاريخ Date and Time الدالة Now : تعيد هذه الدالة تاريخ اليوم و الوقت الحالي باستخدام ساعة الحاسب الذي تعمل علية وتكون بالصورة التالية : كود: Label1.Caption = Now() الدالة Time : تعيد هذه الدالة الوقت الحالي حسب ما هو مدون بساعة الحاسب الذي تعمل علية وتكون بالصورة التالية كود: Label1.Caption = Time() ________________________________________ الدالة Date :تعيد التاريخ الحالي حسب ما هو مسجل بالحاسب ويكون بالصورة التالية : كود: Label1.Caption = Date() ________________________________________ الدالة Day والدالة Month :تعيد الدالة Day() رقما يقع بين 1 ، 31 يمثل ترتيب اليوم المقابل لقيمة تاريخية بينما تعيد الدالة Month() رقما يقع بين 1 ، 12 يمثل ترتيب الشهر المقابل لقيمة تاريخية كود: Label1.Caption =Day(Date())Label1.Caption =Month(Date()) ________________________________________ الدالة DateSerial : تعيد هذه الدالة التاريخ المسلسل المقابل لليوم والشهر والسنة المدون بين الأقواس وتأخذ الصورة التالية : كود: GetDate=DateSerial(2003,4,11)MsgBox GetDate ________________________________________ الدالة TimeSerial : تعيد هذه الدالة الوقت المسلسل المقابل للساعة و الدقيقة و الثانية المدونة بين الأقواس وتأخذ الصورة التالية : كود: Get_Time=TimeSerial(12,59,20)MsgBox Get_Time ________________________________________ الدالة DateValue : تعيد هذه الدالة التاريخ المقابل لتعبير معين وتأخذ الصورة التالية : كود: RelVal = DateValue(Now – 1(MsgBox RelValSelect Case RelVal Case Is < Int(Now): Verb "كان "= Case Is > Int(Now): Verb = "سيكون" Case Else: Verb = "اليوم هو"End SelectWhatDay = Format(RelVal, "dddd”)MsgBox UserDate & Verb & WhatDay يبن هذا المثال تحديد يوم من أيام الأسبوع (أمس) بعد تحديد قيمة تاريخ اليوم (بفرض : الاثنين الموافق 2سنة 1997) ثم طرح (1) منة يظهر الناتج في صورة رسالة بان أمس "كان الأحد" . ________________________________________ دوال Hour,Minute,Second,TimeValue: كود: Hour(رقم)Minute(رقم)Second(رقم)TimeValue(تعبير) تعيد هذه الدوال قيم الساعة ، الدقيقة ، الثانية أو الوقت . كود: Midnight=TimeValue(“23:59:59”)HourDiff=Hour(Midnig ht)-Hour(Now)MinuteDiff=Minute(Midnight)-Minute(Now)SecondDiff=Scond(Midnight)-Second(Now)+1If Second Diff=60 Then MinuteDiff=MinuteDiff+1 SecondDiff=0End IfIf MinuteDiff=60 Then HourDiff=HourDiff+1 MinuteDiff=0End IfTotalMinDiff=(HourDiff*60)+MinuteDiffTotal SecDiff=(Total MinDiff*60)+SeconDiffMsg=”إجمالي الوقت المتبقي علي منتصف الليل هو”& Format(Total SecDiff,”#,##0”)Msg=Msg&”ثانية ، يمكن ترجمتها إلي”Msg=Msg & HourDiff & “ساعة، ” & MinuteDiffMsg=Msg & “دقيقة، و ” & SecondDiff & “ثانية”Msg BoxMsg يستخدم هذا المثال الدوال السابقة لتحويل الوقت المتبقي علي منتصف الليل إلى ثواني ثم ترجمة هذا الوقت إلى ساعات ودقائق وثواني في رسالة كهذه "إجمالي الوقت المتبقي علي منتصف الليل هو 79972 ثانية يمكن ترجمتها إلى 22 ساعة 12 دقيقة 25 ثانية " ________________________________________ الدالة Weekday : تعيد هذه الدالة ترتيب اليوم بين أيام الأسبوع من التاريخ المدون بحقل التاريخ أو القيمة التاريخية باعتبار أن يوم الأحد رقم 1 والاثنين 2 ... وهكذا كود: Label1.Caption = Weekday(#1/4/97#) ________________________________________ الدالة Year : تعيد هذه الدالة رقما يعبر عن السنة لتاريخ معين . كود: Label1.Caption = Year(#1/4/97#) ________________________________________ الدالة DateAdd : تعيد هذه الدالة تاريخ جديد بعد أن تضيف له قيمة جديدة وبصرف عن اسم هذه الدالة فهي تعمل مع كل من التاريخ و الوقت . ويوضح الجدول التالي المقصود بالمعامل "الفاصل الزمني " و القيم التي يمكن تخصيصها له : الفاصل الزمني -----------التوضيــــــــــــــــــــح yyyy ----------- سنة q -----------ربع سنة m -----------شهر y -----------يوم في سنة d -----------يوم w -----------يوم من الأسبوع ( الأحد 1 ، والاثنين 2 ... وهكذا ww -----------أسبوع h -----------ساعة n -----------دقيقة s -----------ثانية كود: Label1.Caption = DateAdd("yyyy", -10, Date( وفي هذا المثال تعيد هذه الدالة السنة الحالية 2003 إلى 10 سنوات مضت 1993 ________________________________________ الدالة DateDiff : تقوم هذه الدالة بإعادة الفرق بين تاريخين . Label1.Caption = DateDiff("y", 2000, 2003( بينما المثال التالي يحدد عدد الأسابيع وعدد الأيام ما بين أول أيام سنة 2003 وتاريخ اليوم كود: Label1.Caption = DateDiff("ww", #4/5/2003#, Now())Label2.Caption = DateDiff("y", #4/10/2003#, Now()) ________________________________________ الدالة DatePart : تقوم هذه الدالة بإعادة جزء من التاريخ (مثل اليوم أو الشهر أو الأسبوع أو الساعة ) ويتم تعين هذا الجزء بواسطة الفاصل الزمني . تعيد الدالة في هذا المثال رقم اليوم المحدد في حقل تاريخ الاعتماد (OrderDate ) كود: Label1.Caption = DatePart("w", OrderDate)

قارىء الباركود يعمل كما تعمل لوحة المفاتيح بالضبط بل هو يقوم بحركتين : بالكتابة والتحديث اضبط برنامجك بحيث تدخل الرقم يدويا من لوحة المفاتيح ثم تضغط 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