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

سجل معلوماتك في صفحة واحدة و ارسلها كل مغلومة الى صفحتها المخصصة writ_In_One Sheet.rar

كود بسيط لهذا الغرض Sub xx() Columns.Hidden = True Range("a1,c1,e1,j1,o1,z1").EntireColumn.Hidden = False End Sub

اخى ابو البراء ومن باب حب التعلم رجعت للموضوع ده تانى لاضافة تعريف المتغيير الذى لم اقم بتعريفه فى حينه لاننى لا اجيد كتابة الاوامر ومازلت اتعثر ولكن اعترف اننى عندما قرات مشاركتك بتركيز الان عرفت ان المتغير اللى هنعرفه هنا الى هو ws هيكون متغير وركشيت محدش يكون جعان ويفهم غلط ده مش ورك فرخه هههههههههههههه المهم Sub Macro1() Dim ws As Worksheet For Each ws In Worksheets With ws.PageSetup .BlackAndWhite = True End With Next ws End Sub اخى وحبيبى ابو البراء جزاك الله كل خير واحسن الله إليك كما تحسن إلينا وتصبر علينا بالتوفيق اخى

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

السلام عليكم ورحمة الله وبركاته إخواني الكرام تعودنا على التلقي وفقط .. ويبدو أن أسلوب التلقي لن يوصلنا إلى الترقي .. من ثم سنتجه نحو منحدرٍ آخر لعلنا نصل إلى العلياء بعد الانحدار خطر ببالي فكرة ... وهي أن نتناول موضوع للبحث كل أسبوع (كل يوم جمعة) إن شاء الله ، نبحث جميعاً ونوجد الحلول ونستخدم كل الإمكانيات الممكنة للوصول لأفضل الحلول .. والتي من شأنها تجعلنا نرتقي ونتقدم في هذا المجال موضوعنا اليوم للبحث هو كيفية إخفاء كل الأعمدة ما عدا أعمدة محددة... حتى نكون أكثر دقة دعنا نخفي كل الأعمدة ونبقي فقط العمود 1 و 3 و 5 و 10 و 15 و 26 ..أي أن هذه الأعمدة ستكون هي فقط الأعمدة الظاهرة كل يدلي بدلوه في موضوع البحث تقبلوا وافر تقديري واحترامي

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

أخي العزيز محمد علي سالم شرفتنا بتواجدك معنا في الموضوع سأقوم بشرح بسيط لكود الأستاذ سليم علها تكون البداية لك Sub xx() Columns.Hidden = True Range("a1,c1,e1,j1,o1,z1").EntireColumn.Hidden = False End Sub السطر الأول يبدأ بكلمة Sub يليها اسم الإجراء واسم الإجراء أنت حر فيه سمه بما تريد وأفضل أن تكون التسمية معبرة عن الهدف من الكود مثلاً UnhideSpecificColumns .. وفي آخر سطر قفلة الكود بالجملة End Sub ما بين السطرين البداية والنهاية هذا هو لب الكود (ودا ملوش علاقة بالسوداني .. ولا المصري !!) السطر الأول في الكود يقوم بإخفاء الأعمدة كلها ...أينعم حيث أن الخاصية المستخدمة هي الخاصية Hidden وتعني مخفي .. إذاً ترجمة السطر الأعمدة. مخفي =صح يعني إخفاء كل الأعمدة لو غيرنا القيمة True إلى False تفتكر ايه اللي ممكن يحصل ؟؟ معروف إن True عكسها False ..إذاً سيقوم السطر في هذه الحالة بإظهار كل الأعمدة السطر الأول إذاً يقوم بإخفاء كل الأعمدة مرة واحدة (دفعة واحدة وفي نفس واحد) ثم السطر الثاني يأتي ليحدد اعمدة يعينها للتعامل معها وإظهارها .. وهنا أخونا الغالي سليم استخدم أول خلية في كل عمود من الأعمدة المراد إظهارها ، فالخلية a1 تمثل العمود الأول .. المهم جمع الخلايا في نطاق واحد كما هو مشار في الكود بهذا الشكل Range("a1,c1,e1,j1,o1,z1") ثم استخدم الخاصية EntireColumn والتي تتعامل مع العمود بالكامل ثم الخاصية Hidden والتي تحدثنا عنها ، وهنا إشارة لكل الأعمدة المطلوبة وفي النهاية تم وضع القيمة False لها لإظهارها دون سواها أرجو أن أكون وفقت في توصيل المعلومة تقبل تحياتي

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

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

Sub saadabed() Dim X As Long For X = 1 To 147 Sheets("Table").Columns("a").Offset(, X).EntireColumn.Hidden = True Next Range("a1,c1,e1,j1,o1,z1").EntireColumn.Hidden = False End Sub اخوانى الاعزاء تلميذ من تلاميذ الاخ ياسر يحاول ان يشارك معكم استخدام حلقات التكرارية لاخفاء كل الاعمده ثم اظهار المطلوب منها فقط

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

وبمكنك بدلاً من تسمية نطاق معرف .. يمكن الإشارة إلى النطاق في الكود نفسه بهذا الشكل Sub xx() Dim rng As Range Set rng = Range("a1,c1,e1,j1,o1,z1") Columns.Hidden = True rng.EntireColumn.Hidden = False End Sub وهي نفس فكرة أخونا الغالي سليم بالضبط مع فصل النطاق لنعبر عنه بمتغير .. بدلاً من تسمية نطاق بهذا الشكل .. =ورقة1!$A:$A,ورقة1!$C:$C,ورقة1!$E:$E,ورقة1!$G:$G,ورقة1!$I:$I,ورقة1!$K:$K,ورقة1!$M:$M,ورقة1!$O:$O,ورقة1!$Q:$Q,ورقة1!$S:$S,ورقة1!$U:$U,ورقة1!$W:$W,ورقة1!$Z:$Z ابحث عن الأيسر والأسهل تقبل تحياتي

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

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

حبيبى الغالى أبو البراء دى مساهمه بسيطه منى من اجل التعلم والبحث المثمر فى سبيل التعلم طبعا انا عارف ان فى طرق ابسط واسهل من كده بس هحاول برضه للاحسن Sub hid() Sheets("ورقة2").Select Columns("b").Hidden = True Columns("d").Hidden = True Columns("f:i").Hidden = True Columns("k:n").Hidden = True Columns("p:y").Hidden = True Columns("aa:xfd").Hidden = True End Sub جزاك الله كل خير يا ابو البراء hid_ahmed.rar

دالة offset من الدوال المهمة لتحديد نطاق الخلايا وتوفير الإجهاد على الملف.. لمعرفة كيفية عملها شاهد الصورة المرفقة ولكم تحياتي

السلام عليكم اخى الكريم جرب المعادلة التاليه جيداً .... -- معادلة صفيف CTRL + SHIFT + ENTER ... تم الغاء دمج الخلايا .. =INDEX(VLOOKUP(E23;$E$3:$H$6;{2;3;4};0);MATCH(0;COUNTIF($F$22:F22;VLOOKUP(E23;$E$3:$H$6;{2;3;4};0)&""))) مشكل توزيع_2.zip

العفو استاذ سعيد ! وما هذا الا شي لايذكر مقابل مساعدتك للاخرين ! بالتوفيق

تمام تاكد اولا ان التاق به بيانات ! ممكن الاختبار بالامر التالي خلف زر مثلا ! msgbox(me.tag)

ممكن توضح اكثر ! وهل هي مشكلة قائمة ام تم التغلب عليها ! تحياتي

اوكي حسب الكود السابق يظهر جدول وحقل واحد اتوقع يحفظ به اسم النموذج هنا راح اضيف حق قيمة التاق وليكن باسم ftag وعلى نفس الجدول هنا الكود سيصبح Function checkAllForms() Dim aob As AccessObject For Each aob In CurrentProject.AllForms docmd.open aob.name DoCmd.RunSQL "insert into tblallfrms (frmnname,ftag) values ('" & aob.Name & "','" & forms(aob.name).tag & "')" docmd.close acform,aob.name Next aob End Function والكود كتبته في المحرر مباشرة وبدون اختبار ! قد يكون بمثابة ارشاد للحل ! ويمكن فتح النماذج في حالة اخفاء ! بالتوفيق

مرحبا بك استاذ سعيد ساكتفي بالتنبيه التالي وعليك الباقي انت تريد قراءة خاصية كائن ليس مفتوح ! معناته افتح الكائن ثم اقرأ الخاصية ثم اغلقه ! بالتوفيق

حياك الله اخوي الشمال هذا شكل الكود بعد التعديل Private Sub cmdEnter_Click() On Error Resume Next If IsNull([txtSerialNo]) Or ([txtSerialNo]) = "" Then MsgBox "لم تقم بإدخال رقم التسجيل ، نرجو إدخال الرقم والمحاولة مجددا", vbOKOnly + vbMsgBoxRight + vbCritical, "إجراء غير مكتمل" Me.txtSerialNo.SetFocus ElseIf (Me.HardiskSerial.Value - 52361369) * 2 = Val(Me.txtSerialNo) Then Dim Count As Integer Count = Nz(DCount("SerialNo", "SerialNo"),0) DoCmd.SetWarnings False If Count > 0 Then DoCmd.RunSQL "UPDATE SerialNo SET SerialNo.SerialNo = [forms]![Start]![txtSerialNo];" MsgBox "النسخة اصلية", vbOKOnly + vbMsgBoxRight + vbInformation, "تم التسجيل بنجاح" DoCmd.Close DoCmd.OpenForm "Al_Name" ElseIf Count = 0 Then DoCmd.RunSQL "INSERT INTO [SerialNo] ([SerialNo]) VALUES ('" & [txtSerialNo] & "')" MsgBox "النسخة اصلية", vbOKOnly + vbMsgBoxRight + vbInformation, "تم التسجيل بنجاح" DoCmd.Close DoCmd.OpenForm "Al_Name" ElseIf (Me.HardiskSerial.Value - 52361369) * 2 <> Val(Me.txtSerialNo) Then MsgBox "عفواً ، رقم التسجيل غير صحيح ً" & vbCr & "سيتم إنهاء البرنامج", vbOKOnly + vbMsgBoxRight + vbCritical, "فشل في عملية التسجيل" DoCmd.Quit End If End If End Sub بالنسبة للفورم لوق ان في الوحدة النمطية فهو غير موجود لذلك عدله الى اي نموذج في المثال .. بالتوفيق

السلام عليكم تسلم ايديك أخى المبدع سليم واسمح لى بابداء بعض الملاحظات على الكود المسخدم أولا : السطر التالى i = .Range("A" & Rows.Count).End(xlUp).Row + 1 والخاص بتحديد أول سطر فارغ فى الصفحات المرحل اليها يعتمد على العمود A لايجاد أخر سطر به بيانات ثم يزيد عليه واحد لايجاد أول سطر فارغ وهذا ينتج عنه خطأ اذا كانت البيانات فى الصفحة الرئيسية لا تحتوى على بيانات فى العمود A مما يؤدى الى عدم ترحيل البيانات من الصفحة الرئيسية فى حالة أن تكون الخلية الموجودة فى العمود A فارغة كما يتضح من الصور التالية ولذلك يجب تعديل السطر السابق الى الصورة التالية لتلافى هذا الخطأ i = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1 ثانيا : يجب الوضع فى الاعتبار مسح البيانات القديمة فى الصفحات المرحل اليها قبل الترحيل لتجنب تكرار البيانات لذا يتم وضع هذا الجزء فى بداية الكود لمسح البيانات من الصفحات المرحل اليها قبل الترحيل For Each sh In ThisWorkbook.Worksheets If Not sh.Name = "MAIN_SHEET" Then sh.[A2:C1000].ClearContents End If Next مع خالص تحياتى وتقديرى لشخصكم الكريم writ_In_One Sheet1.rar

جرب هذا الكود الكود لا ينفذ العمل الا اذا امتلأ اخر صف في الجدول Private Sub Worksheet_Change(ByVal Target As Range) lr = Cells(Rows.Count, 2).End(3).Row If Target.Row = lr Then If Application.WorksheetFunction.CountA(Range(Cells(lr, 1), Cells(lr, 8))) = 8 Then Range("A10:H" & lr).Select ActiveWorkbook.Worksheets("مثال1").Sort.SortFields.Clear ActiveWorkbook.Worksheets("مثال1").Sort.SortFields.Add Key:=Range("E11:E" & lr) _ , SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _ "محاسب,شئون عاملين,مهندس ميكانيكا,مهندس كهرباء,سائق,فني تشغيل", DataOption:= _ xlSortNormal With ActiveWorkbook.Worksheets("مثال1").Sort .SetRange Range("A10:H" & lr) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End If End If End Sub

هو لب ولا سوداني ولا سوري ولا أي جنسية في الوطن العربي ..؟؟!

جزاك الله خير اخى محمد على هذه الكلمات فهمت مقصدك قم بوضع سطر اخر لاظهار ما تريد بمعنى Columns("c").Hidden = false حاول اخى محمد ولا تخاف من الفشل لان الفشل اول طريق النجاح وصدقنى انا كل ما فعلته اننى بحثت فى جوجل هههههههههههههه لاصل لهذا الكود ابحث وحاول واسال وسال ولن يقصر معك احد باذن الله تعالى فكلنا هنا اخوه فى الله واسره واحده اسمها اسرة اوفيسنا السعيده بحب الله ورضاه

انا لا اعلم شي عن الاكواد ولكن إن شاء اتعلمها اخي احمد عندي افكار ولكن لما استطع تنفيذها بالاكواد يكفيك شرف المحاولة فانت افضل مني اما انا فلم استطع انا افعلها وانا اتعلم منكم انا اقصد ليس الحذف وانما اخفيت خانني التعبير اخي احمد اعذرني بمعنى عندما ابدل حرف السي مثلا إلى b في الكود ثم اعود وابدل حرف b إلى حرف السي لا يظهر العمود السي مرة اخرى ولا انا عندي خطأ في إكسل 2010 وانت ما شاء الله عليك مبدع ويكفيك شرف المحاولة ارفع القبعة لك احتراما وتقديرا بارك الله فيك وبارك الله فيكم جميعاً

إذا كانت أرقام التسلسل لهذه الأسماء الثلاثة معروفة لديك يمكنك وضع معيار فى حقل التسلسل بالاستعلام مثلا <>125 and <>126 أو not in(125,126,127)

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

هدية رائعة من الاستاذ / سليم

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

السلام عليكم بجد وبدون مجاملة كلام جميل جدا بارك الله بك وجزاك الله كل خير

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

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

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

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

جرب الكود بهذا الشكل Sub Test() Dim WS As Worksheet, SH As Worksheet Dim Cel As Range Dim lRow As Long Set WS = Sheets("أداة بناء الخطط"): Set SH = Sheets("ورقة1") Application.ScreenUpdating = False SH.Range("B3:M1000").ClearContents For Each Cel In WS.Range("H3:H43") If Cel.Value >= 0.9 Then lRow = SH.Cells(Rows.Count, "B").End(xlUp).Row + 1 SH.Cells(lRow, "B").Value = Cel.Offset(, 1) ElseIf Cel.Value <= 0.5 Then lRow = SH.Cells(Rows.Count, "H").End(xlUp).Row + 1 SH.Cells(lRow, "H").Value = Cel.Offset(, 1) End If Next Cel Application.ScreenUpdating = True End Sub تم إضافة سطر واحد يقوم بمسح البيانات قبل الشروع في الكود SH.Range("B3:M1000").ClearContents تقبل تحياتي

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

لمزيد من الفائدة إليكم رابط الموضوع http://chandoo.org/wp/2012/09/17/offset-formula-explained/ وإليكم الملف المرفق غير محمي (من سلسلة الانتقام يا عربي) .. لأن المرفق في الموضوع الأصلي محمي !! Offset Formula Interactively Explained.rar

الطلب الاول الرئيسي وهو الحفظ تفضل تم التطبيق على ثلاث نماذج فرعية اكمل كما هو موضح بالكود شرح الطريقة : بما ان تسميات الحقول بحروف عربية فانا اكتفيت بتسمية الحقل الاول في كل نموذج وسميته z1 عند النقر على زر الحفظ يجري التالي : 1- نقل التركيز على الحقل الفرعي 2- جعل قيمة z1 = z1 يعني ستكون مساوية للقيمة الافتراضية او للقيمة التي تم تغييرها 3- تحديث النموذج الفرعي 4- الانتقال للنموذج الفرعي الآخر .... وهكذا انا شرحت لك الطريقة حتى اكفيك عناء السؤال فضلا الاسئلة الاخرى افتح لكل سؤال موضوعا يخصه vv.rar

أخي الحبيب رجب جاويش بارك الله فيك وجزاك الله كل خير .. لقد افتقدنا وجودك لعل غيابك خير ... لا تحرمنا من تواجدك معنا فأنت في القلب تقبل وافر تقديري واحترامي

السلام عليكم تفضل أخى استخدم المعادلة الآتية للتنسيق الشرطى فى حالة الحضور =INDEX(B2:B14;MATCH(B20;A2:A14;0))="حضر" والمعادلة الآتية فى حالة عدم الحضور =INDEX(B2:B14;MATCH(B20;A2:A14;0))="لم يحضر" حضور.rar

حياك الله اختي الكريمة الق نظرة على الرابط http://www.officena.net/ib/topic/34968-اظهار-المكرر-فقط-تمت-الإجابة/ بالتوفيق

وعليكم السلام أخوي جعفر وين هالغيبة تفضل: Private Sub Form_Current() MyTime = Now() Me.pic.Visible = True Me.نص7.Visible = True Me.نص11.Visible = True End Sub Private Sub t_Change() Dim i As String i = Len(Me.t.Text) If i >= 4 Then DoCmd.Requery Dim db As DAO.Database, rs As DAO.Recordset Set db = CurrentDb Set rs = db.OpenRecordset("t2") rs.AddNew rs("an") = Me.an rs("adate") = Date rs("intime") = Me.LabelDate rs.Update rs.Close t = "" t.SetFocus PauseTime = 20 ' Set duration. Start = Timer ' Set start time. Do While Timer < Start + PauseTime DoEvents ' Yield to other processes. Loop Me.pic.Visible = False Me.نص7.Visible = False Me.نص11.Visible = False End If End Sub تقدر تلعب بسطر التأخير ،بالثوان: PauseTime = 20 جعفر 304.abc.mdb.zip

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

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

اكتب هذه المعادلة مقابل اول خلية و اسحب نزولاً =COUNTIF(A$3:A3,A3)

لا ليست الفاصلة بل عدلت كلمة الدرجة لتصبح الدرجـة لاحظ بين الجيم والتاء المربوطة

تفضل أخي الحبيب Dynamic Chart.rar