علي السحيب

الكود التالي ينفذ لك ماتريد: Private Sub Worksheet_SelectionChange(ByVal Target As Range) For R = 6 To 35 If Target.Address = "$C$4" Then Cells(R, 10) = Sheet2.Cells(R, 4) Cells(R, 11) = Sheet2.Cells(R, 5) Cells(R, 12) = Sheet2.Cells(R, 6) [I4] = Target ElseIf Target.Address = "$C$5" Then Cells(R, 10) = Sheet2.Cells(R, 9) Cells(R, 11) = Sheet2.Cells(R, 10) Cells(R, 12) = Sheet2.Cells(R, 11) [I4] = Target ElseIf Target.Address = "$C$6" Then Cells(R, 10) = Sheet2.Cells(R, 14) Cells(R, 11) = Sheet2.Cells(R, 15) Cells(R, 12) = Sheet2.Cells(R, 16) [I4] = Target ElseIf Target.Address = "$C$7" Then Cells(R, 10) = Sheet2.Cells(R, 19) Cells(R, 11) = Sheet2.Cells(R, 20) Cells(R, 12) = Sheet2.Cells(R, 21) [I4] = Target End If Next End Sub شاهد المرفق، ______________________________________.rar

الكود التالي يفي بالغرض: Private Sub Worksheet_SelectionChange(ByVal Target As Range) For R = 2 To [A65536].End(xlUp).Row Cells(R, 3) = Cells(R, 1) * Cells(R, 2) Next End Sub شاهد المرفق، _____________________________________________________.rar

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

راجع الرابط التالي: http://www.officena.net/ib/index.php?showtopic=2350

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

شاهد المرفق، 564.rar

استبدل الكود الذي لديك بالكود التالي: Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 7 Then Range("G" & Target.Row) = Date End If End Sub

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

ويا ترى .. ماهو سبب المشكلة التي واجهتها؟؟؟؟

نفس الكود موجود بشكل مبسط على الرابط التالي: http://www.officena.net/ib/index.php?showtopic=14214

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

شاهد المرفق، __________________________________3_.rar

عفواً أخي Triste .. لزحمة المواضيع المطروحة في المنتدى .. ولقلة دخولي إلى المنتدى هذه الأيام .. لم أنتبه للمشاركة التي تحدثت عنها .. وإلا لما تركتك تنتظر لفترة طويلة من أجل الحصول على حل لمشكلة هي بالواقع بسيطة جدً .. ويمكن حلها بأكثر من طريقة .. والصيغة التالية لوحدها تفي بالغرض بالكامل وبدون أي أعمدة إضافية .. =INDEX(C2:I6,IF(C16<98.5%,1,IF(C16<99%,2,IF(C16<99.5%,3,IF(C16<100%,4,IF(C16>=100%,5,""))))),IF(B16<=60,1,IF(B16<=80,2,IF(B16<=120,3,IF(B16<=160,4,IF(B16<=200,5,IF(B16<=220,6,IF(B16>=221,7,"")) شاهد المرفق، __________________________________..________.rar

شاهد المرفق للتأكد من أن مجال الإدخال الذي أشرت إليه يعمل بشكل صحيح وسليم .. ربما تكون المشكلة لديك متعلقة بتنسيق التاريخ الخاص بنظام الويندوز نفسه .. وللتأكد راجع الرابط التالي: http://www.officena.net/ib/index.php?showtopic=13472 يمكنك كتابة التاريخ بالترتيب الذي تشاء .. ولكن يجب عليك أولاً أن تضبط تنسيق الخلية .. وتنسيق جمبع خلايا إدخال التاريخ في المرفق الموجود في مشاركتي السابقة تم ضبطهم على هذا التنسيق (سنة/يوم/شهر) _____.rar

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

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

وعليكم السلام، الصيغة صحيحة .. تأكد من أنك تقوم بإدخال التاريخ من اليسار إلى اليمين بالترتيب التالي: سنة/يوم/شهر وتم عمل التعديلات والإضافة المشار إليها .. شاهد المرفق، ______________________________________________________________.rar

تم إضافة التعديل المطلوب .. وتم أيضاً إضافة خاصية جديدة وهي عدد الخطوات المُراد لكل رقم أن يخطوها للرقم الذي يليه .. بعبارة أخرى .. إذا أردنا أن يكون ترتيب الأرقام في السلسلة على النحو التالي: 1 ثم 2 ثم 3 .. فهذا يعني أننا نريد الرقم الأول أن يخطوا خطوة واحدة فقط إلى الرقم الذي يليه .. فنكتب في مربع عدد الخطوات الرقم 1. أما إذا أردنا أن يكون ترتيب الأرقام هكذا: 1 ثم 3 ثم 5 .. فهذا يعني أننا نريد الرقم الأول أن يخطوا خطوتان إلى الرقم الذي يليه .. فنكتب في مربع عدد الخطوات الرقم 2. وهكذا.... شاهد المرفق، ____________________________________.rar

كان من المفروض أن تطرح هذا السؤال في موضوع جديد .. على كل حال .. الكود التالي يفي بالغرض: Sub Numbering() For R = 1 To Selection.Rows.Count Cells(ActiveCell.Row, ActiveCell.Column)(R) = R Next End Sub شاهد المرفق، Numbering_Selected_Cells.rar

الملف سليم 100% .. أخي عمر .. ربما يكون الأخ Kask .. قد قام بنقل الكود الخاص بالصفحة فقط إلى ملف آخر ونسي أن ينقل الموديول المتصل بالكود .. إذا كان الأمر كذلك أخي Kask .. قم بإستبدال الكود الذي لديك بالكود التالي .. وستحل المشكلة بإذن الله: Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$E$5" Then ActiveSheet.Unprotect "123" If Target = 1 Then Target.Interior.ColorIndex = 12 If Target = 2 Then Target.Interior.ColorIndex = 35 If Target = 3 Then Target.Interior.ColorIndex = 6 If Target = 4 Then Target.Interior.ColorIndex = 3 If Target = 5 Then Target.Interior.ColorIndex = 40 ActiveSheet.Protect "123" End If End Sub شاهد المرفق، ____________________3_____.rar

الآن فقط أتضح لي ماتريد بالضبط .. وكما ذكرت في الكود السابق كان هناك خلل في تلوين خلفية الخلية وعدم تلوينها عندما يكون لون الخط أخضر .. وأصبح الكود بعد التعديل هو التالي: Private Sub Worksheet_Change(ByVal Target As Range) TC = Target.Column TR = Target.Row If TC > 1 And TC < 7 And TR < 5 Then If Target > Cells(TR, 1) Then Target.Interior.ColorIndex = 19 Target.Font.ColorIndex = 10 ElseIf Target < Cells(TR, 1) Then Target.Interior.ColorIndex = 34 Target.Font.ColorIndex = 3 ElseIf Target > Cells(TR, TC - 1) Then Target.Interior.ColorIndex = xlNone Target.Font.ColorIndex = 10 ElseIf Target < Cells(TR, TC - 1) Then Target.Interior.ColorIndex = xlNone Target.Font.ColorIndex = 3 End If End If End Sub شاهد المرفق، Conditional_Formatting.rar

ولإثراء الموضوع أخي فلسطيني .. الصيغة التالية تحل محل الكود: =IF(E15="","",IF($F$7="مسافة",E15/$F$6*35,IF($F$7="زمن",$F$6/E15*35,""))) شاهد المرفق، ____________.rar

شاهد المرفق، _________________________________.rar

الحل هو أن تقوم بإضافة الكود التالي في المصنف المرتبط بالمصنف الرئيسي .. وهو بمجرد فتح المصنف الجديد يقوم بإغلاق جميع المصنفات الأخرى المفتوحة ويظل بمفرده . Private Sub Workbook_Open() For Each Wkb In Workbooks If Wkb.Name <> ThisWorkbook.Name Then Wkb.Saved = True Wkb.Close End If Next Wkb End Sub لإختبار عمل الكود قم بفتح عدد من المصنفات أولاً .. ثم أفتح المصنف الموجود في المرفقات. _____________________________________________________..rar

شاهدا المرفق، _____________________________________3.rar