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

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

تفضل أخى رجب.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

السلام عليكم اخي الفاضل يمكنك ذلك عن طريق الدالة countif

ما أعلم أن قيمة المدخل بالحقل يقاس بالبيت bit ومعلوم أنها أصغر وحدة قياس وسواء تم ادخال الصفر أم ترك الحقل فارغ فلا فرق ولكن المهم هو نوع وحجم البيان الذى تم تخصيصه للحقل عند تصميم الجدول فإن الأكسس يحجز لهذا الحقل حجما بالذاكرة على قدر نوع وحجم البيان المعد من قبل المصمم سواءا ترك الحقل فارغا فيما بعد أو ملأ بالبيانات, مثال: لنفترض أن الحقل A بالجدول tbl1 اعداده نص وحجمه 255 فإن الأكسس يحجز لهذا الحقل بالذاكرة 255 بيت بغض النظر عن حجم البيان الذى سيتم ادخاله بعد فى هذا الحقل أكان مساوى ل 255 أم لا أم كان الحقل فارغا أصلا. هذا والله أعلم

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

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

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

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

جعلنا اسم المستخدم في متغير عام ويتم جلبه عند فتح النموذج وعند الضغط على زر جديد ب2.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)

السلام عليكم الحمد لله الذى بنعمته تتم الصالحات شرح الفكرة تفصيلاً علها تمثل إضافه لاحد الاخوة التطبيق بالمرفق El RashedY_ VlookUp.rar

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

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

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

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

تفضل اخى الكريم ولكن هذه المره لامفر من الكود والزر ارجو ان يفى بالغرض دوائر حمراء.rar

السلام عليكم ورحمة الله اخي الكريم الرابط المرفق هو رابط تحميل البرنامج الذي قمت باعداده ولا احتاج الا لاظهار شريط ادوات الطباعةفي التقرير (التقرير هو التصريح الذي اريد طباعته ) مع العلم ان البرنامج قد تم تحويله الى ملف تنفيذي ولكنه قابل للتعديل وارجو منك ومن الاخوة هنا وهو الاهم اعطاء راي الخبراء بالعمل الذي قمت به لانه اول برنامج اقوم بتجهيزه واتمنى منكم ابداء الملاحظات او التعديلات اذا سمحتم وشكرا الك رابط تحميل البرنامج : http://www.4shared.c...bile-store.html

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