اذهب الي المحتوي

herofox

الاعضاء
  • عدد المشاركات

    16
  • تاريخ الانضمام

  • تاريخ اخر زياره

السمعه بالموقع

0 Neutral

عن العضو herofox

  • الرتبه
    عضو جديد

أخر الزائرين للملف الشخصي

بلوك اخر الزائرين معطل ولن يظهر للاعضاء

  1. السلام عليكم اساتذتى الكرام -عذرا لرفعى المشاركة هنا فلا أعرف ما هو سبب عدم تمكنى من رفع مشاركة مستقلة بارك الله فيكم جميعا تعديل كود البحث فى عدة صتعديل كود البحث فى عدة صفحات من خلال الكمبوبوكس داخل الفورمفحات من خلا ل الكمبوبوكس داخل الفورمارجو التكرم على مساعدتى فى تعديل كود الفورم الموجود بالملف لكى يتم البحث فى كل الصفحات من خلال الكمبوبوكس لكى يساعدنى ذلك فى اضافة وتعديل وحذف البيانات الى جميع الصفحات وذلك من خلال اليوزرفورم ' Dim r, i As Integer Private Sub ComboBox1_Change() On Error Resume Next Dim ws As Worksheet Set ws = Sheets("ÇáÈíÇäÇÊ") Me.TextBox13.Value = WorksheetFunction.VLookup(Val(Me.ComboBox1.Value), ws.Range("A2:G1000"), 2, 0) Me.TextBox14.Value = WorksheetFunction.VLookup(Val(Me.ComboBox1.Value), ws.Range("A2:G1000"), 3, 0) Me.TextBox15.Value = WorksheetFunction.VLookup(Val(Me.ComboBox1.Value), ws.Range("A2:G1000"), 4, 0) Me.TextBox16.Value = WorksheetFunction.VLookup(Val(Me.ComboBox1.Value), ws.Range("A2:G1000"), 5, 0) Me.TextBox17.Value = WorksheetFunction.VLookup(Val(Me.ComboBox1.Value), ws.Range("A2:G1000"), 6, 0) Me.TextBox18.Value = WorksheetFunction.VLookup(Val(Me.ComboBox1.Value), ws.Range("A2:G1000"), 7, 0) End Sub Private Sub CommandButton1_Click() For j = 1 To 6 Cells(r, j) = Controls("TextBox" & j).Text Next j ListBox1.List(i, 0) = TextBox2.Text End Sub Private Sub CommandButton2_Click() If Me.ComboBox1.Value = "" Then MsgBox "ÚÝæÇ íÌÈ ÇÎÊÇÑ ÇáÔíÊ ÇáãÑÍá Çáíå ÇáÈíÇäÇÊ" Exit Sub End If Worksheets(Me.ComboBox1.Value).Activate Dim lastrow lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row lastrow = lastrow + 1 Cells(lastrow, 1) = Me.TextBox1.Value Cells(lastrow, 2) = Me.TextBox2.Value Cells(lastrow, 3) = Me.TextBox3.Value Cells(lastrow, 4) = Me.TextBox4.Value Cells(lastrow, 5) = Me.TextBox5.Value Cells(lastrow, 6) = Me.TextBox6.Value Cells(lastrow, 7) = Me.TextBox7.Value Cells(lastrow, 8) = Me.TextBox8.Value Cells(lastrow, 9) = Me.TextBox9.Value Cells(lastrow, 10) = Me.TextBox10.Value Cells(lastrow, 11) = Me.TextBox11.Value Cells(lastrow, 12) = Me.TextBox12.Value TextBox1.Value = Application.WorksheetFunction.Max(ActiveSheet.Range("A15:A44")) + 1 TextBox2.SetFocus End Sub Private Sub CommandButton3_Click() If MsgBox("ÓíÊã ÇáÍÐÝ åá ÃäÊ ãÊÃßÏ¿", vbQuestion + vbYesNo) = vbYes Then Sheets(1).Cells(r, 1).EntireRow.Delete For Z = 1 To 6 Sheets(1).Cells(r, Z).Delete Shift:=xlUp Next Z Sheets(1).Cells(r, 1).Resize(r, 6).Delete Shift:=xlUp MsgBox "ÊãÊ ÚãáíÉ ÇáÍÐÝ ÈäÌÇÍ" For y = 1 To 6 'Controls("Textbox" & y).Text = "" Next y ListBox1.Clear UserForm_Activate TextBox7 = "" End If End Sub Private Sub CommandButton4_Click() Me.PrintForm End Sub Private Sub CommandButton5_Click() End End Sub Private Sub CommandButton6_Click() TextBox2.Text = "" TextBox3.Text = "" TextBox4.Text = "" TextBox5.Text = "" TextBox6.Text = "" TextBox7.Text = "" TextBox8.Text = "" TextBox9.Text = "" TextBox10.Text = "" TextBox11.Text = "" TextBox12.Text = "" TextBox13.Text = "" TextBox14.Text = "" TextBox15.Text = "" TextBox16.Text = "" TextBox17.Text = "" TextBox18.Text = "" End Sub Private Sub ListBox1_Click() For i = 0 To ListBox1.ListCount If ListBox1.Selected(i) = True Then For j = 1 To 6 Controls("TextBox" & j).Text = Cells(ListBox1.List(i, 1), j) Next j r = ListBox1.List(i, 1) Exit For End If Next i End Sub Private Sub ListBox2_Click() TextBox1.Value = ListBox2.Column(0) TextBox2.Value = ListBox2.Column(1) TextBox3.Value = ListBox2.Column(2) TextBox4.Value = ListBox2.Column(3) TextBox5.Value = ListBox2.Column(4) TextBox6.Value = ListBox2.Column(5) TextBox7.Value = ListBox2.Column(6) TextBox8.Value = ListBox2.Column(7) 'TextBox9.Value = ListBox2.Column(8) 'TextBox10.Value = ListBox2.Column(9) End Sub Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) For i = 1 To 13 Controls("Textbox" & i).Text = "" Next i TextBox1.Value = Application.WorksheetFunction.Max(Sheets(1).Range("A15:A44")) + 1 TextBox2.SetFocus End Sub Private Sub TextBox19_Change() If TextBox19.Value = "" Then ListBox2.Clear: Exit Sub Dim X As Worksheet Set X = ActiveSheet ListBox2.Clear k = 0 ss = X.Cells(Rows.Count, 13).End(xlUp).Row For Each c In X.Range("M15:M44" & ss) M = InStr(c, TextBox19) If M > 0 Then ListBox2.AddItem ListBox2.List(k, 0) = X.Cells(c.Row, 1).Value ListBox2.List(k, 1) = X.Cells(c.Row, 2).Value ListBox2.List(k, 2) = X.Cells(c.Row, 3).Value ListBox2.List(k, 3) = X.Cells(c.Row, 4).Value ListBox2.List(k, 4) = X.Cells(c.Row, 5).Value ListBox2.List(k, 5) = X.Cells(c.Row, 6).Value ListBox2.List(k, 6) = X.Cells(c.Row, 7).Value ListBox2.List(k, 7) = X.Cells(c.Row, 8).Value ListBox2.List(k, 8) = X.Cells(c.Row, 9).Value k = k + 1 End If Next c End Sub Private Sub TextBox20_Change() End Sub Private Sub TextBox7_Change() ListBox1.Clear For i = 1 To 6 Controls("TextBox" & i).Text = "" Next i If TextBox7 = "" Then Exit Sub Sheets(1).Activate ss = Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row k = 0 For Each c In Range("B2:B" & ss) If c Like TextBox7.Value & "*" Then ListBox1.AddItem ListBox1.List(k, 0) = Cells(c.Row, 2).Value ListBox1.List(k, 1) = c.Row k = k + 1 End If Next c End Sub Private Sub TextBox5_DblClick(ByVal Cancel As MSForms.ReturnBoolean) TextBox7.Value = "" ListBox1.Clear End Sub Private Sub TextBox8_Change() ListBox2.Clear For i = 1 To 6 Controls("TextBox" & i).Text = "" Next i If TextBox8 = "" Then Exit Sub Sheets(1).Activate ss = Sheets(1).Cells(Rows.Count, 5).End(xlUp).Row k = 0 For Each c In Range("E2:E" & ss) If c Like TextBox8.Value & "*" Then ListBox2.AddItem ListBox2.List(k, 0) = Cells(c.Row, 5).Value ListBox2.List(k, 1) = c.Row k = k + 1 End If Next c End Sub Private Sub UserForm_Activate() TextBox7.SetFocus For i = 2 To ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row ListBox1.AddItem ListBox1.List(i - 2, 0) = Cells(i, 15).Value ListBox1.List(i - 2, 1) = i Next i For i = 1 To 12 Controls("TextBox" & i).Text = "" Next i TextBox1.Value = Application.WorksheetFunction.Max(Sheets(1).Range("A15:A44")) + 1 TextBox2.SetFocus End Sub برنامج_الشركة_2018-2019_الجديد.xlsm
  2. محاولة رائعة استاذى بارك الله فيك وجعله فى ميزان حسناتك ولكنى اريد ادخال الخلية E5 وبها تاريخ اخر ترقية كبند ايضا للحساب فى المعادلة فلا أريد ان اعمل هذا يدويا فهذا نموذج مصغر فلدى اكثر من 200 موظف فلا استطيع القيام بهذه المعادلة يدويا لكل هذا الكم فحضرتك اعتمدت على ان اخر ترقية للموظف الأول مثلا فى 2013 فأدخلت فى حساب المعادلة من الخلية i على اساس انها فى 2014 فأريد ان تجعل المعادلة فى الحسبان بداية من العمود F على ان ترى ان هذا العمود سنة 2011 فالمفروض فى حالة هذا الموظف الأول وبناءا على كل الشروط انه قد تلقى اخر تقييم له سنة 2017 اى بعد اخر ترقية له باربع سنوات ولكن التقييم اقل من الممتاز بمعنى انه اقل من 90 % ,اذن انه لا يستحق اى ترقية وان تضع ايضا فى الحسبان عند عمل المعادلة الفئة الوظيفية بحيث لو كانت الدرجة الحالية لأى موظف الموجودة بالعمود D هى ب1 ,فلا يصح له اى ترقية,لأنه لا يوجد ترقية بعد هذه الدرجة كما هو وارد ومسجل فى الجدول الموجود بصفحة BASIC اتمنى ان تكون قد وضحت الفكرة لحضرتك لك كل الشكر
  3. أرجو المساعدة رجاءا بارك الله فيكم جميعا
  4. اتمنى ياريت احد الأساتذة يقدر يساعد جزاكم الله كل خير فأنا أريد دالة تأتى لى بكلمة ترقية اذا كان هذا الموظف يستحق الترقية فعلا بما هو محقق له كما هو وارد ومطابق فى الجدول الموجود فى صفحة Basic -بصرف النظر عن المعادلة التى وضعتها فأنا لا اعرف المعادلة المطلوبة فى هذه الحالة فعلى سبيل المثال فى حالة الموظف الأول أحمد هنا فإنه لا يستحق الترقية,لأن هذا الموظف تلقى اخر ترقية فى عام 2013 بدرجة ب3 واخر تقييم له كان فى 2017 اى بعد مرور 4 سنوات من الترقية الأخيرة ,وبناءا على المعطيات من الجدول الموجود فى صفحة BASIC فإنه يجوز له الترقية من هذه الدرجة الى التى يليها بعد مرور 4 سنوات كما فى هذه الحالة ولكن شرط ان تكون نسبة التقييم ممتاز اى من 90% الى 100% , وهو ما لا يتحقق مع هذا الموظف حيث انه تم تقييمه فى 2017 كان 86% اى تقدير جيد جداً وهو يحتاج الى 6 سنوات بهذا التقييم كى يستحق الترقية فى هذه الحالة بارك الله فيك استاذى الكريم وجزاك الله كل خير اتمنى المساعدة وأرجو ان اكون قد وضحت المشكلة فأرجو المعادلة اللازمة لهذا الموضوع
  5. إنشاء معادلة ترقيات موظفين السلام عليكم اساتذتى الكرام أرجوا منكم مساعدتي في انشاء معادلة او دالة ترقيات لموظفين مجموعة موظفين يتم تقيمهم كل سنة ويأخذ متوسط التقيم الكلي مع مرور السنوات وهناك شروط للترقية مبينة على التقييم بالجدول الموجود فى صفحة BASIC جزاكم الله جميعا كل خير وأعتذر لعرضى للمشاركة هنا فلا استطيع وضع مشاركة منفصلة فلا أعرف ما السبب ترقيات.xlsx
  6. تفضلوا اخوانى بعد اذن استاذنا صاحب الموضوع هذه نسخة بدون كلمة السر المخازن-.xls
×