أبو حنــــين

المرفق 2.rar

هذه محاولة ربما تفي بالغرض lp modif.rar

الملف يعمل عندي بشكل طبيعي مثل ما ذكرت من شروط جرب المرفق Book1.rar

أخي الملف الذي ارسلته لا يحتوي على الفورم الاول و الثاني الموجودين في الصورة

العفو أخي الحبيب : / عباس

حسب فهمي لما هو موجود في الملف و بعد اذن اخواني الاساتذة جرب هذا الكود Private Sub CommandButton1_Click() If Range("D25") = 0 Or Range("D25") = Empty Then Rows("24:25").Hidden = True Else Rows("24:25").Hidden = False End If '************************************************************************************* If Range("D31") = 0 Or Range("D33") = 0 Or Range("D35") = 0 Or Range("D37") = 0 Then Rows("31:37").Hidden = True Else Rows("31:37").Hidden = False End If Activewindow.SelectedSheets.PrintPreview End Sub

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

جرب هذا الكود قم بوضع زر ثم انسخ الكود التالي Private Sub CommandButton2_Click() With Range("A2:L35") .Select Selection.Copy Set Newdoc = CreateObject("Word.Application") On Error Resume Next With Newdoc .Documents.Add .Visible = True .Selection.Paste Application.CutCopyMode = False End With End With End Sub

جرب هذ ا Private Sub CommandButton1_Click() Range("b2").Borders.LineStyle = xlContinuous End Sub Private Sub CommandButton1_Click() Range("b4").Borders.LineStyle = xlEdgeBottom End Sub

أخي : / flash012 أرجو ان ترسل الملف بأصدار 2003 و بدون حماية

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

هذا المرفق كما طلبت و الله اعلم قوائم.rar

انني في صدد المحاولة امهلني بعض الوقت

السلام عليكم 1.rar

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

قم بإضافة زر و اكتب الكود التالي Private Sub CommandButton1_Click() For t = 1 To 100 If Val(Cells(t, 1).Value) > Val(Cells(t, 2).Value) Then Cells(t, 2).Value = Val(Cells(t, 1).Value) ElseIf Val(Cells(t, 1).Value) < Val(Cells(t, 3).Value) Then Cells(t, 3).Value = Val(Cells(t, 1).Value) ElseIf Val(Cells(t, 1).Value) < Val(Cells(t, 2).Value) Then Exit Sub ElseIf Val(Cells(t, 1).Value) = Val(Cells(t, 2).Value) Or Val(Cells(t, 1).Value) = Val(Cells(t, 3).Value) Then Exit Sub End If Next End Sub

هذا شرح في عجاله و ان لم يكن واضحا سأعيده بعد ساعة لظرف خاص Private Sub Worksheet_Change(ByVal Target As Range) ' حلقة تكرار تتكرر تكرار زوجي ' Step 2 بمعني عندما نقول ' ينتقل المؤشر بالاعداد مثلا 2 ثم 4 ثم 6 ثم 8 و هكذا ' Step 3 بمعني عندما نقول ' ينتقل المؤشر بالاعداد مثلا 3 ثم 6 ثم 9 ثم 12 و هكذا For t = 4 To 249 Step 2 ' t اذا كان العمود الموافق للارقام التي اخترناها مسبقا و التي يمثلها الحرف 'فانه يكتب في الخلية اليمنى للخلية النشطة يكتب تاريخ اليوم If Target.Column = t Then Target.Offset(0, 1).Value = Date Next ' اذا كانت الخلية النشطة في هذا العمود فارغة يترك خانة التاريخ فارغة If IsEmpty(Target.Value) Then Target.Offset(0, 1).Value = Empty End Sub

جرب هذا الكود Private Sub Worksheet_Change(ByVal Target As Range) For t = 4 To 249 Step 2 If Target.Column = t Then Target.Offset(0, 1).Value = Date Next If IsEmpty(Target.Value) Then Target.Offset(0, 1).Value = Empty End Sub

جزاك الله خيرا اخي : / أبو أحمد

بالنسبة للأوفيس 2003 تكون العملية كما في الصورة 1.rar

الشرح Private Sub Worksheet_Change(ByVal Target As Range) '------------------------------------------------------------------------- ' اذا كان الحدث موجود في العمود الرابع فإنه يقوم بالتالي If Target.Column = 4 Then '------------------------------------------------------------------------- '------------------------------------------------------------------------- 'اذاكانت الخلية الحالية غير خالية If Target.Value <> "" Then '------------------------------------------------------------------------- '------------------------------------------------------------------------- ' يكتب التاريخ في الخلية التي في يمينها مباشرة Target.Offset(0, 1) = Date '------------------------------------------------------------------------- '------------------------------------------------------------------------- ' و إلا Else '------------------------------------------------------------------------- '------------------------------------------------------------------------- ' و إلا يقوم بمسح هذه الخلية Target.Offset(0, 1) = "" '------------------------------------------------------------------------- End If End If End Sub

مثال مثال2.rar

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

جرب اخي يوسف المرفق يوسف.rar

آمين يا رب العالمين لنا و لكل المسلمين جزاك الله خيرا اخي الحبيب : / فهد جزاك الله خيرا أخي الحبيب : / يوسف