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

[محمد عبدالسلام]

السلام عليكم ورحمة الله وبركاته طلب مساعدة

نحن مجموعة من الشباب (20) شخاص نجمع في كل شهر مبلغ 100 دينار لي شخص، قومنا بعمل قرعة بيننا على من يأخذ مبلغ 2000 دينار، من يأخذ في شهر الاول وفي شهر الثاني وفي شهر الثالث وهكدا حتى اخير وحد ، وطبعاً يستمر في الدفع حتى تكتمل المجموعة وبعد أن يتحصل كل الشباب على نصيبهم وتكتمل المجموعة، وذلك لا يتم إلا بعد 20 أشهر قومت بعمل قائمة من الاسماء الشباب في ملف اكسيل

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

قرعة.xlsm

[حسين مامون]

ربما يكون المرفق ما تريد 

قمت ببعض الاضافة في الجدول وذلك لمنع تكرار العملية في نفس اليوم

الكود يعمل عند فتح الملف

قرعة.xlsm

[حسين مامون]

تفضل

قرعة.xlsm

[محمد عبدالسلام]

شكرا كثير ماشاءلله جزاك الله خيرا

 ممكن اخي في عمود c  في كل شهر يتم نسخ اسم شخص المقابل عمود a   

 

[حسين مامون]

تفضل

Private Sub Workbook_Open()
Dim ws As Worksheet
Dim lr
Dim x
x = Date

Set ws = Sheets("ورقة1")
With ws
lr = .Cells(Rows.Count, "c").End(3).Row
If .Range("c" & lr).Offset(, 1) = x Then MsgBox "تمت العملية لهذا الشهر ": Exit Sub
If Format(x, "dd") = 13 Then ' غير القيمة لتتناسب مع اليوم الذي تريد تنفيذ الكود فيه
'ws.Range("c" & lr + 1).Value = "تم"
.Range("c" & lr + 1).Value = .Range("c" & lr + 1).Offset(, -2).Value
.Range("c" & lr + 1).Interior.ColorIndex = 6
.Range("c" & lr + 1).Offset(, 1).Value = Date
End If
End With
End Sub

 

[محمد عبدالسلام]

السلام عليكم ورحمة الله وبركاته

جزاكم الله خير الجزاء في الدنيا والآخرة على اهتمامك بالموضوع

كود لا يعمل هل يجب عليا عمل بعد تنسيقات في الملف لي يعمل الكود

[حسين مامون]

اخي الكريم

الملف شغال في حدث فتح

يعني عند فتح الملف ينفذ اذا كان التاريخ في الجهاز مطابق للتاريخ في الكود

ملاحظة يمكنك تغيير التاريخ في الكود حسب ما تريد

قرعة.xlsm

[محمد عبدالسلام]

جزاك الله خيـرا  بارك الله في جهودك وأسال الله لك التوفيق دائما