تنفيذ الكود في شيت آخر غير شيت مصدر الكود

[riyad_1]

السلام عليكم ورحمة الله وبركاته, الأساتذة الفضلاء

لدي كود يعمل تمام بحمد الله ولكن لا يتنفذ إلا في الشيت الذي أخذت منه البيانات 

حيث أريد ان يظهر تنفيذ الكود في الصفحة الرئيسية اللي هي اول شيت كما هو مرفق بالملف

وجزاكم اللة خيرً وإحساناً

USER_FORM - Copy.xlsm

[abouelhassan]

تفضل

USER_FORM - Copy.xlsm

[abouelhassan]

نفس مهمة الفورم بالمعادلات اتمنى تعجبك

USER_FORM - Copy.xlsm

[riyad_1]

مشكور اخي أبو الحسن على سعة صدرك

بالمعادلات أنا منفذها كما في الملف المرفق 

المشكلة أن الكود لا يعمل الا على الشيت المأخوذة منة البيانات ونا أريدة أن يعمل على الصفحة الرئيسية الموجودة في الملف

شاكر ومقدر جهدك المبذول

 

[abouelhassan]

بارك الله فيك اخى بصفحة توزيع الموظفين نفس عمل الفورم بالمعادلات صممته لك لو اعجبك تستطيع تنفيذه باى صفحة

مع الشكر

[سليم حاصبيا]

الحلفات التكرارية مرهقة جداً للبرنامج

من الافضل الابتعاد عنها

           1-الكومبو بوكس يذكر جميع الاسماء دون تكرار (دون ادراج عامود اضافي لترقيم الاسماء)     العامود A  الذي لا حاجة له  (قمت باخفائه و ليس حذفه)

           2- تم تصغير حجم اليوزر لتغطية أقل مساحة ممكنة من الشاشة

           3- يمكنك العمل على الصفحة حتى ولو كان اليوزر ظاهراً

اليك هذا الكود الذي يفعل لك ما تريد بالاضافة الى تلوين المعطيات التي تبحث عنها

Option Explicit
Private Sub ComboBox1_Change()
  Dim Sh As Worksheet, Find_Range As Range
  Dim my_rg  As Range
  Dim My_sum#, x As Boolean, T#, ro%
  Dim k%: k = 0
  Dim First_Address

Set Sh = Sheets("توزيع الموظفين")
 Me.TextBox1 = "": Me.ListBox1.Clear
 ro = Sh.Cells(Rows.Count, 4).End(3).Row
 Set my_rg = Sh.Range("B1:B" & ro)
 Range("A2:D" & ro).Interior.ColorIndex = xlNone
   Set Find_Range = my_rg.Find(Me.ComboBox1, Lookat:=1)
    Do While Not Find_Range Is Nothing
        If Not x Then
         First_Address = Find_Range.Address
         x = True
        End If
       Range("A" & Find_Range.Row).Resize(, 4).Interior.ColorIndex = 35
        T = IIf(IsNumeric(Range("D" & Find_Range.Row)), _
            Range("D" & Find_Range.Row), 0)
         My_sum = My_sum + T
            With Me.ListBox1
            .AddItem
            .List(k, 0) = Sh.Range("B" & Find_Range.Row)
            .List(k, 1) = T
            End With
         k = k + 1
          Set Find_Range = my_rg.FindNext(Find_Range)
      If First_Address = Find_Range.Address Then Exit Do
      Loop
      Me.ListBox1.AddItem
        Me.ListBox1.List(k, 0) = "المجموع :"
        Me.ListBox1.List(k, 1) = My_sum
        Me.TextBox1 = My_sum

End Sub
'+++++++++++++++++++++++++++++++++++++++++
Private Sub UserForm_Initialize()
    Dim My_sh As Worksheet, lr
    Dim dic As Object, i%

    Set My_sh = Sheets("توزيع الموظفين")
    Set dic = CreateObject("Scripting.Dictionary")

lr = My_sh.Cells(Rows.Count, 1).End(3).Row
    For i = 2 To lr
      dic(My_sh.Cells(i, 2).Value) = ""
    Next
Me.ComboBox1.List = dic.keys
Set dic = Nothing: Set My_sh = Nothing
End Sub
'+++++++++++++++++++++++++++++++
Private Sub UserForm_Terminate()
Dim Sh As Worksheet, ro%
 Set Sh = Sheets("توزيع الموظفين")
ro = Sh.Cells(Rows.Count, 4).End(3).Row
Range("A2:D" & ro).Interior.ColorIndex = xlNone
Set Sh = Nothing
End Sub

الملف مرفق

 

SAlim_USER_FORM.xlsm

[سليم حاصبيا]

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

مثلاً الصفة الاولى تجتوى على جدول ِِ من A  حتي D بينما الصفحات الباقية تحتوي عدة جداول يأعمدة مختلفة

[abouelhassan]

ربنا يبارك لك استاذ سليم 

[riyad_1]

الف شكر لك أخي سليم وبارك اللة فيك وفي علمك وجزاك اللة خيراً

وشكراً على توضيحاتك