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

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

تفضل أخى رجب.rar

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

أخي الكريم محمد قم بعمل عمود مساعد ليسهل عليك الأمر ، وفي النهاية يمكنك إخفاء العمود المساعد في الخلية R12 اكتب كلمة "عمود مساعد" .. وضع المعادلة التالية في الخلية R13 =C13&D13&E13&F13 ثم ضع الكود التالي في موديول ونفذ الكود ليقوم بعملية الترتيب كما طلبت Sub SortData() Dim LR As Long LR = Range("B" & Rows.Count).End(xlUp).Row Range("B12:R" & LR).Sort Key1:=Range("R12:R" & LR), Order1:=xlAscending, Header:=xlYes End Sub إليك الملف المرفق بعد إزالة كافة الفورم والموديولات والإبقاء على الكود المطلوب فقط حتى لا يتوه الأعضاء في الطلب ويستطيع من يحمل المرفق أن يفهم المرفق بسهولة يرجى عدم تعدد الطلبات في الموضوع الواحد ..يمكنك طرح موضوع لكل طلب على حدا Sort Data In Ascending Way YasserKhalil.rar الطلب الثاني وهو فتح ملف الورد قم بوضع الكود التالي مع تغيير اسم ملف الورد ليناسب طلبك Dim objWord As Object Set objWord = CreateObject("Word.Application") objWord.Visible = True objWord.Documents.Open (ThisWorkbook.Path & "\Ahmed.docx") objWord.Activate تقبل تحياتي

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

أخي الكريم المسلم العربي تقوم الدالة Countif بعمل المطلوب حيث تقوم الدالة بالعد بشرط تذكره .. الدالة لها عدد 2 بارامتر الأول هو النطاق المراد عده والثاني هو الشرط المطلوب العد على أساسه بالتالي كما في مثالك ..النطاق المراد العمل عليه وعد الشرط به هو E3:E12 ، والشرط المطلوب هو كلمة "ذكر" في حالة أن المطلوب عد الذكور ، ولا تنسى أن كلمة ذكر توضع بين أقواس تنصيص لأنها نص في النهاية تكون المعادلة بهذا الشكل =COUNTIF(E3:E12,"ذكر") الفاصل بين البارامترات الخاصة بالدالة يكون فاصلة عادية أو منقوطة (حسب إعدادات الويندوز لديك) .. إذا لم تعمل المعادلة بهذا الشكل قم باستبدال الفاصلة العادية الموجودة في المعادلة بفاصلة منقوطة ; يمكن الاستغناء عن الشرط كنص أي بدلاً من كتابة كلمة "ذكر" في المعادلة يمكن كتابتها في أي خلية ترغب فيها وليكن الخلية C14 اكتب فيها كلمة ذكر (بدون أقواس تنصيص في هذه الحالة) ..ثم قم بوضع المعادلة بهذا الشكل ... =COUNTIF(E3:E12,C14) أرجو أن تكون الصورة واضحة والشرح مفهوم تقبل تحياتي

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

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

السلام عليكم وتأييدأ لأخي أبوخليل ، وإيضاحا بالصور: http://www.officena.net/ib/topic/66616-لصق-ارتباط/?do=findComment&comment=433253 جعفر

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

السلام عليكم مرحبا بأخى الحبيب ياسر خليل المنتدى كدا نور بجد حمد لله على السلامة أخى محمد جرب المعادلة التالية =SUMIFS(OFFSET($B$7;;MATCH($B$3;$B$6:$J$6;0)-1;29;1);$A$7:$A$35;">="&$B$1;$A$7:$A$35;"<="&$B$2) تطبيق بدالة sumifs.rar

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

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

بارك الله فيكم إخواني الكرام لسؤالكم عني أنا بخير والحمد لله وقد كنت منشغلاً في بعض الأمور .. وإن شاء الله سأكون معكم جزيتم خيراً لسؤالكم عني تقبلوا تحياتي

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

تفضل أخى Private Sub ComboBox1_Change() ComboBox2_Change End Sub Private Sub ComboBox2_Change() Dim c As Range Dim cc As Range Dim LR As Integer If ComboBox1.Text = "" Or ComboBox2.Text = "" Then TextBox1 = "" TextBox2 = "" End If LR = Cells(Rows.Count, 1).End(xlUp).Row For Each c In Range("A5:A" & LR) For Each cc In Range("C4:O4") If c = ComboBox1.Text And cc = ComboBox2.Text Then TextBox1 = Cells(c.Row, 2) TextBox2 = Cells(c.Row, cc.Column) Exit For End If Next Next End Sub رجب.rar

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

دورة برنامج Excel فيديو وصوت ( عربي )

جرب هذا الملف عشوائى salim.rar أو هذا توزيع عشوائي دون تكرار1 adv.rar

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

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

ولو حبيت تختصر المعادلة فى الخلية يمكنك تسيمة النطاق التالى =OFFSET(B7;MATCH(B1;A7:A35;0)-1;;MATCH(B2;A7:A35;0)-MATCH(B1;A7:A35;0)+1;37) ووضع الاسم وليكن ragab مثلا فى المعادلة فتكون المعادلة على الصورة التالية =SUM(ragab) تطبيق بدالة sumifs.rar

السّلام عليكم و رحمة الله و بركاته واصل أخي الغالي " محمد حسن المحمّد " إبداعاتك .. و الله الموفّق فائق إحتراماتي

اخى رجب بارك الله فيك بالفعل رايت ردك وكنت بحاول افهم الكود قبل ما اسالك وجزاك الله كل خير على المساعده الدائمه والتوضيح الرائع ووضحت الرؤيا كلها بارك الله فيكم

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

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

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

بارك الله فيك ونفع بعلمك برنامج روعة من استاذ رائع

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

اخي ياسر تم بحمدالله العمل بدون اعمدة مساعدة بمعادلة صفيف (Ctrl+Shift+Enter) =IF(COLUMNS($C$1:C1)<7,INDEX(Sheet2!$D$5:$I$7,MATCH($A5&$B5,Sheet2!$B$5:$B$7&Sheet2!$C$5:$C$7,0),MATCH(C$3,Sheet2!$D$3:$I$3,0)),INDEX(Sheet3!$D$5:$I$7,MATCH($A5&$B5,Sheet3!$B$5:$B$7&Sheet3!$C$5:$C$7,0),MATCH(C$3,Sheet3!$D$3:$I$3,0))) و هذه معادلة اخرى بدون عامود مساعد برده و عادية (بدون Ctrl+Shift+Enter) =IF(COLUMNS($C$1:C1)<7,INDEX(Sheet2!$D$5:$I$7,IF($A5&$B5=Sheet2!$B5&Sheet2!$C5,ROWS($C$1:C1)),MATCH(C$3,Sheet2!$D$3:$I$3,0)),INDEX(Sheet3!$D$5:$I$7,IF($A5&$B5=Sheet3!$B5&Sheet3!$C5,ROWS($C$1:C1)),MATCH(C$3,Sheet3!$D$3:$I$3,0)))

أخي الكريم ناصر سعيد يرجى تغيير اسم الظهور للغة العربية (أنت عضو قديم وتعرف التوجيهات) شاهد الملف التالي فيه شرح مبسط للطريقة الأولى بدون أكواد .. Watch.rar

جزاك الله خير برنامج رائع جداااااااااااا

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

كيف تدرج جدولاً عشوائياً بأي عدد من الصفوف و الاعمدة دون تكرار انظر الى المرفق table_rand_numebr.rar

بارك الله فيكم إخواني وأحبابي على الحلول الجميلة أخي الكريم إتش جرب الملف التالي عله يفيدك .. Sub CountSumCF() Dim Ws As Worksheet, I As Integer, J As Integer Application.ScreenUpdating = False For Each Ws In ThisWorkbook.Worksheets Ws.Activate I = I + CountCFCells(Ws.Range("A1").CurrentRegion, Sheet1.Range("F1"), False) J = J + CountCFCells(Ws.Range("A1").CurrentRegion, Sheet1.Range("F1"), True) Next Ws MsgBox "Yellow Cells In All Sheets Count = " & I & vbNewLine & "Yellow Cells In All Sheets SUM = " & J Sheet1.Activate Application.ScreenUpdating = True End Sub Function CountCFCells(Rng As Range, C As Range, bCount As Boolean) Dim I As Single, J As Long Dim Chk As Boolean, Str1 As String, CFCELL As Range Application.Volatile Chk = False For I = 1 To Rng.FormatConditions.Count If Rng.FormatConditions(I).Interior.ColorIndex = C.Interior.ColorIndex Then Chk = True Exit For End If Next I J = 0 If Chk = True Then For Each CFCELL In Rng Str1 = CFCELL.FormatConditions(I).Formula1 Dim II As Integer Dim IIFlg As Boolean Dim Tmp IIFlg = False For II = 1 To Len(Str1) Tmp = Mid(Str1, II, 1) If ("0123456789" Like "*" & Tmp & "*") Then IIFlg = True Else If (IIFlg) Then Exit For End If Next Tmp = Right(Str1, Len(Str1) - II + 1) Str1 = "=" & CFCELL.Address & Tmp If bCount = False Then If Evaluate(Str1) = True Then J = J + 1 Else If Evaluate(Str1) = True Then J = J + CFCELL End If Next CFCELL Else CountCFCells = "Color Not Found" Exit Function End If CountCFCells = J Set Rng = Nothing Set C = Nothing End Function تقبل تحياتي Count & Sum Conditional Formatting Cells YasserKhalil.rar

وجزيت خيراً بمثل ما دعوت والحمد لله أن تم المطلوب على خير تقبل تحياتي

أخي الكريم عبد الله جرب المعادلة التالية في الخلية B1 باعتبار أنك قمت بالإدخال في الخلية A1 =TIMEVALUE(REPLACE(A1,LEN(A1)-1,0,":")) وإليك الملف المرفق (مش هبخل عليك زي ما بخلت في المشاركة الأولى بإرفاق الملف) Convert Numeric Values To Time YasserKhalil.rar

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

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

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

جرب التالي ولا حاجة للكود (يمكنك سحب المعادلة غلى اي صف تريد) Count_rows.rar

هل تقصد هكذا ربط 2 كمبوبوكس.rar

أخى الفاضل استعمل هذه المعادلة =OFFSET(st!$A$2;;;COUNTA(st!$A:$A);1)

السّلام عليكم و رحمة الله و بركاته أخي الكريم " رسول " .. ريثما يقوم أحد الأساتذة الأفاضل بمد يد المساعدة بإذن الله .. حاول مع هذا الملف .. يمكنك التغيير بعنوان الخلية و رقم الصف واسم الشيت مثلما تشير له الصّورة أدناه .. إدراج الوثيقة.rar

الإخوة الكرام إستخدمت هذا الكود لمنع حفظ الملف أو حفظه باسم فهل هذا جيد أم أنه هناك طريقة أفضل جزاكم الله خيراً Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 'This macro disables the "Save As" Feature in Excel 'This means that a user will not be able to save this 'workbook(file) under a different name or in a different location ' 'This MUST be placed in "ThisWorkbook" and NOT in a Module. ' Application.CommandBars("Standard").FindControl(ID:=3).Enabled = False If SaveAsUI = True Then Cancel = True End Sub

للرفع ...رفع الله قدركم .. جمالُ اللغةِ العربيةِ سئل أحدُهم : من أسعدُ الناسِ؟ فأجاب قائلاً: من أسعدَ الناسَ

السلام عليكم ورحمة الله وبركاته الموضوع هذا بدأ بسؤال الرابط التالي: http://www.officena.net/ib/topic/65783-البحث-عن-اي-جزء-من-الكلمة-عنوان-معدل/ ولكن لأني غيرت الكود وجعلته يبحث في اي عدد من الحقول في السجل ، لذا رأيت ان اجعل له موضوعا مستقلا يمكنك البحث عن اي جزء من الكلمة ، واذا اردت البحث عن كلمة اخرى في السجل او جزء منها ، فما عليك الا ان تضع (مسافة او / او *) بين الكلمات ، فسيعتبرها البرنامج على انها كلمة اخرى يجب البحث عنها. الشئ المهم في الكود هو طريقة إضافة حقول جديدة للبحث فيها: هذا اول حقل يتم البحث فيه fld = "[كلمات ارشادية]" لما نريد ان نضيف حقول إضافية للبحث فيها ، يجب ان يكون الكود كالتالي fld = fld & " & ' ' & " & "[موضوع الخطاب]" fld = fld & " & ' ' & " & "[my other field]" وكل ما عليك الآن هو ان تطبع وترى نتيجة بحثك: . ملاحظة مهمة: اذا كان برنامجك على الشبكة ، فلا تضع الكود على "حدث التغيير" (معناه ، كلما اضفت/حذفت حرف ، فارجع الى الجدول وخذ البيانات منه) ، لأنه سيجعل البرنامج جدا بطئ ، وانما استخدم زر البحث. جعفر 309.Search_as_you_Type_Multiple_Fields_jj.mdb.zip

أخي الكريم يوسف عطا .. لم أفهم النقطة الأخيرة هلا أرفقت مثال بشكل النتائج المتوقعة ليسهل فهم المطلوب ..

الأخ المتميز زوهير بارك الله فيك على هذا الكود الرائع جزيت خير الجزاء أخي الكريم شكيب عمار .. موضوع الشرح مرهق للغاية استغرق مني الشرح حوالي ساعة ونصف (لا تنسى أن تضغط على كلمة "أعجبني هذا") ولا تضغط على كلمة "تحديد كأفضل إجابة" إذ أن مشاركتي ليست بإجابة إنما هي شرح لما تفضل به الرائع زوهير Option Explicit 'يوضع الكود في حدث الفورم ليتم إضافة واستدعاء وتعديل البيانات 'البيانات في ورقة عمل باسم "ورقة 2" والصف الأول يحمل العناوين الآتية 'كود الموظف - الاسم واللقب - تاريخ الميلاد - الوظيفة 'يتم إنشاء مربع نص للكود وآخر للاسم وآخر لتاريخ الميلاد وآخر للوظيفة 'وزري أمر للاستدعاء والتعديل [ListBox1] ويوضع داخله مربع القائمة [Frame1] يتم إنشاء إطار 'بعنوان البحث والتعديل كما يتم إنشاء زر أمر باسم إضافة [CheckBox1] يتم إنشاء '--------------------------------------------------------------------------------------- Private Sub CheckBox1_Click() 'حيث أن لمربع الفحص قيمتان [CheckBox1] يقوم الكود بالعمل عند النقر على '[True] إذا كان المربع تم تحديده أي وضع علامة صح فإنه يحمل القيمة '[False] إذا كان المربع لم يتم تحديده أي أنه لا توجد علامة صح فإنه يحمل القيمة '--------------------------------------------------------------------------- '[True] فإذا كانت القيمة تساوي If CheckBox1.Value Then 'يظهر الإطار بما في داخله من أدوات Frame1.Visible = True '[False] وإذا كانت القيمة تساوي Else 'يختفي الإطار بما في داخله من أدوات Frame1.Visible = False End If End Sub Private Sub CommandButton1_Click() 'يتم تنفيذ الأسطر عند النقر على زر الإضافة '--------------------------------------- Dim iRow As Long, I As Long 'سطر لتنشيط أو تحديد ورقة العمل الهدف Sheets(2).Activate 'تعيين قيمة للمتغير ليساوي رقم آخر صف به بيانات في العمود الأول iRow = Range("A" & Rows.Count).End(xlUp).Row 'في آخر صف به بيانات يتم الإشارة إلى الصف التالي لأنه أول صف فارغ 'توضع قيمة مربع النص الأول في العمود الأول Range("A" & iRow + 1).Value = TextBox1.Value 'تتم الإزاحة إلى الخلية المجاورة بمقدار عمود واحد وتوضع قيمة مربع النص الثاني Range("A" & iRow + 1).Offset(0, 1).Value = TextBox2.Value 'تتم الإزاحة إلى الخلية المجاورة بمقدار عمودين وتوضع قيمة مربع النص الثالث 'يتم تنسيق مربع النص لتاريخ الميلاد لتظر بهذا التنسيق المذكور في السطر Range("A" & iRow + 1).Offset(0, 2).Value = Format(TextBox3, "yyyy/dd/mm") 'تتم الإزاحة إلى الخلية المجاورة بمقدار ثلاثة أعمدة وتوضع قيمة مربع النص الرابع Range("A" & iRow + 1).Offset(0, 3).Value = TextBox4.Value 'حلقة تكرارية لمسح مربعات النصوص الأربعة بعد ترحيل البيانات For I = 1 To 4 Controls("TextBox" & I).Value = "" Next I End Sub Private Sub CommandButton2_Click() 'يتم تنفيذ الأسطر عند النقر على زر الاستدعاء '----------------------------------------- 'الإعلان عن المتغيرات Dim Zouhir As Worksheet Dim V As Integer, LastRow As Integer Dim M As String Dim Q, F 'سطر لتنشيط أو تحديد ورقة العمل الهدف Sheets(2).Activate '[ListBox1] إظهار مربع القائمة ListBox1.Visible = True 'سطر لتجنب حدوث خطأ On Error Resume Next 'مسح البيانات داخل مربع القائمة ListBox1.Clear 'إذا كان مربع النص الأول فارغ يتم القفز إلى السطر الذي بدايته رقم 1 'أي إنهاء الإجراء الفرعي If TextBox1.Text = "" Then GoTo 1 'تعيين قيمة للمتغير ليساوي قيمة مربع النص الأول M = TextBox1.Text 'تعيين قيمة للمتغير ليساوي ورقة العمل الهدف Set Zouhir = Sheets(2) 'بدء التعامل مع ورقة العمل With Zouhir 'تعيين قيمة للمتغير ليساوي رقم آخر صف به بيانات في العمود الأول LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'تعيين المتغير ليساوي النطاق الذي يطابق البحث عن قيمة مربع النص Set Q = .Range("A2:A" & LastRow).Find(M) 'إذا تم إيجاد الكود الذي يطابق مربع النص If Not Q Is Nothing Then 'يتم تعيين قيمة للمتغير ليساوي عنوان الخلية التي طابقت عملية البحث F = Q.Address 'حلقة تكرارية تنفذ إلى أن تنتهي نتائج البحث عن القيمة الموجودة بمربع النص Do 'سطر يستخدم دالة البحث عن قيمة مربع النص داخل النطاق فإذا كانت النتيجة تساوي 1 If Application.WorksheetFunction.Search(M, Q, 0) = 1 Then 'يتم إضافة العناصر إلى مربع القائمة 'عبارة عن صفوف وأعمدة والصفوف تمثل الفهرس الذي يبدأ من صفر [ListBox1] مربع القائمة 'لم يتم تعيين قيمة له في الأسطر السابقة لذا فإنه يحمل القيمة صفر [V] المتغير المسمى 'تمثل الأرقام 1 و 2 و 3 و 4 أرقام الأعمدة في مربع القائمة ListBox1.AddItem Q.Value ListBox1.List(V, 1) = Q.Offset(0, 1).Value ListBox1.List(V, 2) = Q.Offset(0, 2).Value ListBox1.List(V, 3) = Q.Offset(0, 3).Value ListBox1.List(V, 4) = Q.Offset(0, 4).Value 'العمود الخامس في مربع القائمة وهو وهمي ليحمل عنوان النطاق الحالي المطابق للبحث ListBox1.List(V, 5) = Q.Address 'زيادة قيمة المتغير بمقدار واحد V = V + 1 End If 'مرة أخرى ليساوي هذه المرة نتيجة البحث التالية [Q] تعيين المتغير المسمى Set Q = .Range("A2:A" & LastRow).FindNext(Q) Loop While Not Q Is Nothing And Q.Address <> F End If End With 1 End Sub Private Sub CommandButton3_Click() 'يتم تنفيذ الأسطر عند النقر على زر التعديل '----------------------------------------- 'الإعلان عن المتغيرات Dim Zouh As String Dim MYSH As Worksheet Dim MSG As String Dim ANS As Integer Dim I As Long 'سطر لتنشيط أو تحديد ورقة العمل الهدف Sheets(2).Activate On Error Resume Next 'تعيين المتغير ليساوي السلسلة النصية بعد علامة يساوي MSG = "هل أنت متأكد؟" '[Yes - No] تعيين المتغير ليساوي قيمة النقر على أحد الاختيارين ANS = MsgBox(MSG, vbYesNo) 'إذا كانت الإجابة بنعم يتم تنفيذ الأسطر التالية If ANS = vbYes Then 'تعيين المتغير من النوع سلسلة نصية ليساوي عنوان الخلية في العمود الأول للبيان الذي تم النقر عليه Zouh = ListBox1.List(ListBox1.ListIndex, 5) 'تعيين المتغير ليساوي ورقة العمل الهدف Set MYSH = Sheets(2) 'بدء التعامل مع ورقة العمل With MYSH 'تحديد الخلية للمتغير المشار إليه .Application.Range(Zouh).Activate 'قيمة الخلية نفسها وهنا لا تتم عملية الإزاحة لأنها نقطة البداية وتساوي مربع النص الأول .Range(Zouh).Offset(0, 0).Value = TextBox1.Value 'تتم عملية الإزاحة بمقدار عمود واحد وتساوي مربع النص الثاني .Range(Zouh).Offset(0, 1).Value = TextBox2.Value 'تتم عملية الإزاحة بمقدار عمودين وتساوي مربع النص الثالث .Range(Zouh).Offset(0, 2).Value = TextBox3.Value 'تتم عملية الإزاحة بمقدار ثلاثة أعمدة وتساوي مربع النص الرابع .Range(Zouh).Offset(0, 3).Value = TextBox4.Value End With End If 'حلقة تكرارية لمسح مربعات النصوص الأربعة بعد ترحيل البيانات For I = 1 To 4 Me.Controls("TextBox" & I).Text = "" Next I 'إغلاق الفورم بشكل مؤقت Unload Me 'إظهار الفورم UserForm1.Show 'إخفاء مربع القائمة ListBox1.Visible = False End Sub Private Sub ListBox1_Click() '[ListBox1] يتم تنفيذ الإجراء في حالة النقر داخل '---------------------------------------------- 'في حالة حدوث خطأ يتم إنهاء الإجراء الفرعي On Error GoTo 1 Dim MYSH As Worksheet, Zouh As String 'تعيين المتغير من النوع سلسلة نصية ليساوي عنوان الخلية في العمود الأول للبيان الذي تم النقر عليه Zouh = ListBox1.List(ListBox1.ListIndex, 5) 'تعيين المتغير ليساوي ورقة العمل الهدف Set MYSH = Sheets(2) 'بدء التعامل مع ورقة العمل With MYSH 'تحديد الخلية للمتغير المشار إليه Application.Range(Zouh).Activate 'مربع النص الأول يساوي نطاق الخلية المشار إلى عنوانها TextBox1.Text = .Range(Zouh).Value 'مربع النص الثاني يساوي الخلية المجاورة بمقدار عمود واحد TextBox2.Text = .Range(Zouh).Offset(0, 1).Value 'مربع النص الثالث يساوي الخلية المجاورة بمقدار عمودين TextBox3.Text = .Range(Zouh).Offset(0, 2).Value 'مربع النص الرابع يساوي الخلية المجاورة بمقدار ثلاثة أعمدة TextBox4.Text = .Range(Zouh).Offset(0, 3).Value End With 1 End Sub Private Sub UserForm_Initialize() 'ينفذ هذا السطر عند تشغيل الفورم ويقوم بإخفاء الإطار بما في داخله من أدوات '------------------------------------------------------------------------- Frame1.Visible = False End Sub وزيادة في الخير أرفق لك الملف به الكود مشروح ربما لا تحب أن تقرأ الشرح في المنتدى وتقرأه من داخل محرر الأكواد لا تنسانا بدعوة بظهر الغيب تقبل الله منا ومنكم :gift2: Add Edit Call UserForm Zuhair.rar

السلام عليكم أخي العزيز / aly elhedewy تفضل المرفق فاتورة جديدة5.rar