سعد الفقير

برنامج اكثر من رائع.

ولكن هناك مشكلة عند فتح البرنامج يفتح اول مرة تمام التمام ولكن في المرة الثانية تظهر رسالة كالاتي:

"The macros in this project are disabled.  Please refer to the online help or documentation of the host application to determine how to enable macros."

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

حتى انني غيرت اعدادات المايكرو من هنا ولم تنجح التجربة

>File>Options>Trust Center>Trust Center setting...>Macro Settings and Enabled All Macros

بسم الله ماشاء الله اوفيت وكفيت ابو عيد اتيت بفكرة الفورم التي لم تخطر في بالي سلم فكرك. نعم هذا هو المطلوب جزيت خيرا.

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

شكرا اخي مختار. تمت بنجاح

up

جزيت خيرا مميزكعادتك. 

ماذا لو كنت ارغب ان ينفذ هذا الكود لكل العمود K.

حاولت بهذا الكود ولكن لم ينجح.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$K$2:K50" Then
ActiveWindow.Zoom = 150
Else
ActiveWindow.Zoom = 100
End If
End Sub

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

المتطلبات :

1- في العمود N  يتم ادخال التاريخ الهجري لبداء الاجازة.

2- في العمود P يتم ادخال مدة الاجازة.

3- في العمود O يتم اتوماتيكيا حسب نهاية الاجازة وادراج تاريخ النهاية اتوماتيكيا حسب مدة الاجازة في العمود P .

4- في العمود Q يتم احتساب المتبقي من الاجازة حسب تاريخ اليوم الهجري ومدة الاجازة.

5- عند بلوغ المتبقي للاجازة مدة 3 ايام يتم أضهار رسالة باسم الموظف من العمود G تفيد بان " يجب ادراج - أسم الموظف- في الورديات" ويتم تلوين الخلية باللون الاخضر.

6- عند انتهاء الاجازة يتم أدراج كلمة "أنتهت" في العمود Q ويتم تلوين الخلية بالاحمر ويتم ادراج كلمة "لم يباشر" في العمود S ويتم اضهار رسالة تفيد بان "يجب على - أسم الموظف- مراجعة شئون الموظفين"

7- عند وضع الرقم 1 في العمود T  يتم تحويل كلمة "لم يباشر" الى كلمة "باشر" ويتم ايقاف اضهار الرسالة الخاصة بهذا الموظف.

اتمنى باني وفقت بالشرح. ولكم جزيل الشكر

اخي العيدروس لا ارغب في الكتابة في اي عمود. لان هناك معادلة في العمود S عند انتهاء الاجازة اتومتيكيا تظهر عبارة لم يباشر في العمود. فما اريد هو عند ظهور هذة العبارة اتوماتيكيا في العمود S تاتي الرسالة.

اتمنى بان ترى المعادلة الموجودة في الخلية S2.

الرسالة تاتي بعد فتح ملف الاكسل

اخي العزيز العيدروس اشكر لك مساعدتي ولكن انا لا ارغب بان اكتب كلمة "لم يباشر " في العمود S فعبارة لم يباشر تظهر اتوماتيكيا في العمود وذللك لوجود معادلة بداخلة. والكود الذي ارسلته لا يعمل الا عند كتابة عبارة لم يباشر يدويا.

فمطلوبي عند تحول العمود S اتوماتيكيا لعبارة لم يباشر حسب المعادلة الموجودة فية والمرفقة بالملف. يتم اظهار الرسالة

العيدروس. شكرا لك ولاكن لم يفي الكود بالغرض . لان العمود S يوجد فية معادلة وهي مبنية على نهاية تاريخ الاجازة أو بالاحرى على المعادلة الموجودة في الخلية Q

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

فهدفي هو اظهار رسالة عند فتح الملف تفيد باسماء الموظفين الذين لم يباشروا

up

up

أخي في الله الغالي أبو عيــــــــد

 الف الف الف الف الف مبروك الترقية ونتمنى لك مزيد من النجاح والتوفيق.

السلام عليكم: حاولت في الكود ولكن لم انجح....... ارغب عندما تكون محتويات العمود Sعبارة (لم يباشر) تاتي رسالة باسم الموظف من العمود G تفيد بان "يجب على - اسم الموظف- الأتصال على شئون الموظفين".  وعند بلوغ المتبقي للاجازة 3 أيام  تاتي رسالة باسم الموظف من العمود G تفيد "أدراج - أسم الموظف-في الورديات". ولكم الشكر الجزيل . يوجد كود في حدث الصفحة.علما بان العمود S يحتوي معادلات.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range

Set A = Range("S:S")
Application.EnableEvents = False
If Intersect(Target, A) Is Nothing Then Exit Sub
If Target.Value = "لم يباشر" Then
       
Application.EnableEvents = True
MsgBox "يجب الاتصال على شؤون الموظفين"
End If

End Sub

ssss.rar

لم يسبق بان سجلت باسم سعد الرفيع لانه لا يبت باي صله لي اما الاسم الموجود الان هو الاسم الحقيقي. 

وفقك الله اخي ياسرولنا لقاء ان شاء الله.

لا استطيع الا ان اقول لله درك وزادك من علمة مميز كعادتك. تم حل المشكلة.

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

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

أخي ياسر ظهرت مشكلة وهي عدم الترقيم التلقائي اما الباقي فيعمل مئة بالمئة.

شكرا اخي ياسر تم حل المشكلة والاخذ بالنصيحة بعمل موديول عادي وربطة بزر أمر

أخي ياسر قمت بمراجعة الكود وعدلت علية لكي يعمل معي على الملف الاصلي ولاكن لم يعمل. نسخة مرفقة من الملف الاصلي. 

الكود المعد اسفل وتم تعديل ما تم تلوينة بالون الاحمر. لماذا لم يعمل. شاكر حسن تعاونك.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim LR As Long, LRQ As Long, Cell As Range
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If Not Intersect(Target, Range("H9")) Is Nothing Then
        Application.ScreenUpdating = False
            With Sheets("Quires").Range("B15:G1000")
                .Offset(1).ClearContents
                .Borders.LineStyle = xlNone
            End With
    
            With Sheets("SQ")
                .Rows(1).AutoFilter
                .Rows(1).AutoFilter 11, "=" & Sheets("Quires").Range("H9")
                LR = .Range("A" & .Rows.Count).End(xlUp).Row
                If LR > 1 Then
                    Union(.Range("D2:E" & LR), .Range("G2:G" & LR), .Range("J2:J" & LR), .Range("L2:L" & LR)).Copy
                    Sheets("Quires").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
                End If
                .Rows(1).AutoFilter
            End With
    
            With Sheets("Quires")
                LRQ = .Range("C" & .Rows.Count).End(xlUp).Row
                If LRQ > 15 Then
                    For Each Cell In .Range("B16:B" & LRQ)
                        Cell = Cell.Row - 15
                    Next Cell
                End If
                With .Range("B15").CurrentRegion
                    .Borders.Weight = xlThin
                    .BorderAround Weight:=xlThick
                End With
                .Range("H9").Select
            End With
        Application.ScreenUpdating = True
    End If
End Sub

ماشاء الله زادك الله من علمه اخي ياسر. مبدع

هل بالامكان شرح الكود ليتسنى لي فهمة والتعلم منه. وفقك الله.

up

السلام عليكم:

السؤال موجود في ورقة Quires

هل بالامكان الاختيار من الليست بوكس الموجودة في ورقة Quires وادراج بيانات الموظفين حسب البيانات المدخله في الورقة SQ علما بان البيانات الموجودة في الليست بوكس ماخوذة من الخلية( J )في ورقة ال SQ ….. بمعنى اذا اخترت من الليست بوكس مرضية سوف يدرج جميع الموظفين الذين يتمتعون باجازة مرضية حسب المدخلات في ورقة ال SQ المدرجة في الخلية J      .... ايضا يتم ادراج العدد التسلسلي اتوماتيكيا عند وجود بيانات ويتم تسطير الجدول اتوماتيكيا عند وجود بيانات للموظفين......................              ولكم جزيل الشكر

Copy of 1212.rar

افضل الحل ان يكون في الاكواد VBA

الحمد لله وفقت بحل المعادلة ولكن عندما لايكون هناك عبارة انتهى في الخلية p تظهر عبارة false كيف يتم اخفائها حتى يتحقق الشرط

المعادلة التي وضعتها هي 

’

=IFERROR(IF(P2="أنتهت",IF(R2>0,"لم يباشر","باشر")),"")

شكرا تم حل المعادلة بهذة الطريقة . 

=IFERROR(IF(P2="أنتهت",IF(R2>0,"لم يباشر","باشر"),""),"")

Book1.rar