أبو حنــــين

غير فقط النطاق المسمى sRng الى النطاق (" Range("H3:NV202

السلام عليكم هذه اضافة بسيطة لكتابة ارقام الاآيات و عددها على اعتبار ان لدينا ورقة فيها اعداد الآيات مرتبة بالشكل 7 286 200 176 120 و هكذا حتى سورة الناس 6 Sub NbrAta() m = 0 Dim cl As Range For Each cl In Range("A1:A114") For x = 1 To cl.Value m = m + 1 Cells(m, 2) = x Cells(m, 3) = cl Next Next End Sub

لم افهم المقصود و لاكن يمكن ادراج موديل ثم ربطه بزر او بشرط معين مع تغيير بسيط في السطر : Private Sub CommandButton1_Click() حيث يصبح باي بشكل آخر مثل : Sub Clear()

عمل جد ممتاز اخي ابو البراء جزاك الله خيرا و جعله في ميزان حسناتكم

ها هو الملف Book11.rar

السلام عليكم جرب هذه الطريقة Private Sub CommandButton1_Click() Dim cl As Range For Each cl In Range("H3").CurrentRegion If cl.Locked = False Then cl.ClearContents Next End Sub

السلام عليكم هل تقصد الفلترة بهذه الطريقة Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = Range("L1").Address Then Application.ScreenUpdating = False Range("A2:K152").AutoFilter Field:=3, Criteria1:=Range("L1") Application.ScreenUpdating = True End If If Range("L1") = "" Then Range("A2:K152").AutoFilter End Sub

السلام عليكم ادرج ملفا للعمل عليه

Private Sub UserForm_Activate() For r = 1 To Sheets("ورقة1").[a65500].End(xlUp).Row ListBox1.AddItem Format(Sheets("ورقة1").Cells(r, 1), "dd-mm-yyyy") Next End Sub الكود يكون بهذا الشكل

Private Sub ComboBox1_Change() Sheets(CStr(ComboBox1.Text)).Select End Sub Private Sub UserForm_Initialize() For i = 1 To Worksheets.Count If Not Worksheets(i).Name = "كشف" Then Cells(i, 2) = Worksheets(i).Name ComboBox1.AddItem Worksheets(i).Name End If Next End Sub السلام عليكم استعمل هذا

جميل جدا شرح وافي و كافي و صافي و منو ما في . . . . يلا عوافي

السلام عليكم رغم انه ليس من حقي ان اتدخل في مثل هذه المواقف لكنني رأيت انه من باب احقاق الحق الذي يعلى و لا يعلى عليه ، أنني لا بد أن أدلو بدلوي فإن اصبت فمن الله و ان اخطأت فمني و من الشيطان 1: نعلم أنه لا ينال العمل مستحي او متكبر ، فالذي يحرج ( يستحي ) من طرح السؤال او يدخل في نفسه شيئ من الكبر فهذا لن يصل الى نتيجة و أقصد بكلامي هذا أخونا ابو حمادة الذي لمست من كلامه و كأنه يريد مغادرتنا و نحن لا نود ذلك بل نصّر على بقائه . دعني اقولك شيئين اخي ابو حمادة : أولهما : ان الذي يجيب عن سؤال يستفيد أحسن من من طرحه لان ذلك يحفز فيه روح البحث و الاصرار على الوصول للنتيجة المرجوة و بذلك يكون قد اكتسب شيئ ربما لم يكن يعرفه من قبل او صادفه لاول مرة فيكون بهذا قد استفاد احسن من السائل و ثانيهما : لقد حصل لي مثل ما حصل لك او اكثر و في هذا المنتدى بالذات حينما كنت مشتركا باسم آخر و كنت أجيب عن سؤال لاحد الاخوة فرد عليا قائلا : يافلان اما ان تجيب عن اسئلتي و اما ان لا تشارك في ما اسأل رغم انني قضيت وقتا في الوصول للاجابة التي لم ينتبه لها . هل تعمل ماذا كان ردي فعلى ؟ زدت اصرارا في المشاركات له و لغيره 2: و كما جاء في الاثر قول العرب الذين سبقونا :( ما هكذا تورد يا سعد الإبل ) ، و الشاهد من هذا المثل ان النصح لا ينبغي ان يكون بهكذا طريقة و اقصد بذلك اخونا الصقر الذي و الله اعلم ما في النوايا انه لا يقصد الاحراج و ربما هو الآن يتأسف عن ذلك و هذا ما ينبغي ان يكون ، فالرسائل الخاصة تحل الكثير من المشاكل 3 : لقد حاول اخي ابو البراء ان يرمم الموضوع بالود و كسب الطرفين لكنني ارى انه ليس هناك ما يستلزم القلق و الحيرة فسيبقى اخونا ابو حمادة و غيره يسال مايشاء و سيبق اخونا الصقر يجيب و يجيب و يجيب و بدعم من بقية الاعضاء الخلاصة : لم اقصد بكلامي هذا ان احرج احدا او ان اقف الى جانب احد آخر ، فكل منا لا يعرف الآخر إلا من خلال هذه الشاشة و الله من وراء القصد و السلام عليكم

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

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

سبحان الله العظيم لقد نطقت بإسم والدي رحمه الله فهو اسمه احمد ( دخلنا في الجد )

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

السلام عليكم لم اطلع على الملف رأيت فقط كود أخي أبو لحين فأردت إختصاره فقط و ارجو المعذرة Dim LRow As Long Dim ws As Worksheet Set ws = Worksheets("ورقة1") LRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row If Trim(Me.TxtBox1.Value) = "" Or Trim(Me.TxtBox2.Value) = "" Then If Me.TxtBox1.Value = "" Then Me.TxtBox1.SetFocus Else Me.TxtBox2.SetFocus MsgBox "رجاءا أكمل البيانات", vbExclamation, "خطأ" Exit Sub End If With ws .Cells(LRow, 9).Value = Me.TextBox1.Value .Cells(LRow, 10).Value = Me.TextBox2.Value For i = 1 To 8 .Cells(LRow, i).Value = Me.Controls("TxtBox" & i).Value Me.TextBox1.Value = "" Me.TextBox2.Value = "" Me.Controls("TxtBox" & i) = "" Next Me.TxtBox1.SetFocus End With

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

ابحث عن هذا السطر If InStr(1, .Cells(T, 2), txt, vbTextCompare) = 1 Then ********************************************************************* ثم امسحه و غيره بهذا السطر If .Cells(T, 2) Like "*" & txt & "*" Then

السلام عليكم هل بهذه الطريقة برنامج متابعة ارصدة العملاء2.rar

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

السلام عليكم يبدو و الله اعلم ان هناك شيئ ناقص في مكتبة الكائنات object libiray يمكن الوصول الى هذه المكتبة من القائمة Tools -------> References

غير كود الانصراف بالكود التالي Private Sub CommandButton3_Click() Application.DisplayAlerts = False 'On Error Resume Next Sheets("ورقة1").Visible = True Dim iRow As Long Dim ws As Worksheet Set ws = Worksheets("ورقة1") iRow = ws.Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To iRow '------------------------------------------------------------------------- If Cells(i, 1).Value = Me.ComboBox2.Value And Cells(i, 6).Value <> "" Then GoTo 1 '------------------------------------------------------------------------- If Cells(i, 1).Value = Me.ComboBox2.Value And Cells(i, 6).Value = "" Then Cells(i, 5).Value = Format(Now, "hh:mm:ss") Cells(i, 6).Formula = "=MOD(RC[-1]-RC[-2],24)" Cells(i, 6).Value = Cells(i, 6).Value End If Next ThisWorkbook.Save ComboBox2.Value = "" '---------------------------------------------------------------------------- Exit Sub 1 MsgBox " لا توجد أسماء ", vbInformation, "ملاحظة" End Sub

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

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