طارق نادر

للرفع

للرفع....

للرفع

للرفع....

اخواني ارفق كود الترحيل التالي وارجو منكم اضافة علية امر تلوين البيانات االتي يتم ترحيلها وشكرا لكم دائما وابدا Private Sub CommandButton11_Click() Dim SH As Worksheet Set SH = ThisWorkbook.Sheets("ÇáãÏÑÇÁ (2)") Workbooks.Application.Visible = True Application.ScreenUpdating = False x = SH.Cells(Rows.Count, 2).End(3).Row + 1 Set my_rg = SH.Range("b" & x).Resize(1, 16) 8 For i = 1 To my_rg.Count my_rg.Cells(i) = Me.Controls("TextBox" & i + 1).Value Next Application.ScreenUpdating = True End Sub

اخي زيزو العجوز بعد تعديلك الكريم فقد اكتشفت ان هذا الامر الذي ينفذ نعديل البيانات لا يعمل سارفق لك الكود Private Sub CommandButton4_Click() Dim ws As Worksheet, LastRow As Long Set ws = ThisWorkbook.Sheets("ÇáÈíÇäÇÊ") LastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row + 1 If Me.ComboBox1.Text <> "" Then For T = 2 To LastRow If Me.ComboBox1.Text = ws.Cells(T, 3) Then ws.Cells(T, 2).Resize(1, 14).Interior.Color = vbCyan For i = 2 To 17 ws.Cells(T, i).Value = Me.Controls("TextBox" & i).Value Next MsgBox "Êã ÊÚÏíá ÈíÇäÇÊ ÇáãæÙÝ ÈäÌÇÍ", vbOKOnly + vbInformation, "Êã ÇáÊÚÏíá" GoTo 1 End If Next End If 1 For i = 2 To 17 Me.Controls("TextBox" & i).Value = "" Next CommandButton3.Enabled = False CommandButton4.Enabled = False Me.ComboBox1.Clear TextBox2.SetFocus End Sub

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

هناك مشكلة في فتح الملف اخي الكريم

للرفع رفع الله مقامكم

2017صيفية برمجية 2استعلام.rar

للرفع

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

اخي الكريم حرف s من تعديل الاستاذ حماده عمر ولا اعلم بالضبط تفسيره كتبته كما قال لي ارجو ان يتسع صدرك لي وشكرا اظن انها حلقة تكرارية كما فهمت اخي الفاضل سليم حاصبيا سارفق لك تعديل الاستاذ حمادة عمر لكي تتوضح لك معلومة والاجابة عن استفسارك حول حرف s السلام عليكم الاخ الكريم /n_tareq بارك الله فيك بعد اذن اخي الحبيب / سليم حاصبيا .. جزاه الله خيرا انت قمت فعلا بتنفيذ ما اخبرك به من تعديل اسماء الشيتات ولكنك تجاهلت اسم هذه الشيتات في باقي الكود وبذلك تصبح التعديلات في الكود كما يلي : ** بدلا من السطر التالي للمتغيرات .. Dim i As Integer, LastR As Long, ws As Worksheet سنضيف به المتغير الآخر وهو الورقة الثانية او الشيت الثاني كما هو في السطر التالي Dim i As Integer, LastR As Long, ws, ws1 As Worksheet ** السطرين التاليين Set ws = ThisWorkbook.Sheets("البيانات") Set ws = ThisWorkbook.Sheets("المدراء") سيتم تغييرهم تبعا للمتغيرات التي قمت بوضعهم في الجزئية السابقة كما يلي : Set ws = ThisWorkbook.Sheets("البيانات") Set ws1 = ThisWorkbook.Sheets("المدراء") ** ثم جزئية آخر صف .. سيتم تغيير او اضافة للصف التالي LastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row + 1 كما هو يلي LastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row + 1 LastRow1 = ws1.Cells(Rows.Count, "B").End(xlUp).Row + 1 وبالتالي ستقوم بعمل حلقة تكرارية .. لكل منهما .. لتكن مثلا S مثل T ولكن مع LastRow1 .. ثم يظل الجزء الاول في الكود والخاص بتفعيل عمل المطلوب في حالة اختيار OptionButton1 كما هو بدون تعديل ثم يتم تغيير الجزء الخاص بتفعيل عمل المطلوب من الكود في حالة اختيار OptionButton2 كالتالي If OptionButton2.Value = True Then If TextBox1.Text = Mid(ws1.Cells(S, 3).Text, 1, Len(TextBox1.Text)) Then UserForm1.ComboBox1.AddItem ws1.Cells(S, 3) UserForm1.Controls("TextBox" & i).Value = ws1.Cells(S, i).Value UserForm1.CommandButton4.Enabled = True Unload Me End If

اخي الكريم اريد البحث اما بواسطة الاسم او الرقم الوزاري كما هو في الفورم وبالنسبة لاستفسارك عن s3 هذا تعديل من قبل الاستاذ الفاضل حمادة عمر وسارفق شرحه كما هو ( وبالتالي ستقوم بعمل حلقة تكرارية .. لكل منهما .. لتكن مثلا S مثل T ولكن مع LastRow1 .. ثم يظل الجزء الاول في الكود والخاص بتفعيل عمل المطلوب في حالة اختيار OptionButton1 كما هو بدون تعديل ثم يتم تغيير الجزء الخاص بتفعيل عمل المطلوب من الكود في حالة اختيار OptionButton2 كالتالي If OptionButton2.Value = True Then If TextBox1.Text = Mid(ws1.Cells(S, 3).Text, 1, Len(TextBox1.Text)) Then UserForm1.ComboBox1.AddItem ws1.Cells(S, 3) UserForm1.Controls("TextBox" & i).Value = ws1.Cells(S, i).Value UserForm1.CommandButton4.Enabled = True Unload Me End If

للرفع

ارفق الكود بعد التعديل من قيل اخواني الكرام ولكن بقيت المشكلة قد يكون السبب قلة دقتي في التعديل المطروح من قبل الاخوان الافاضل لذا سارفق الكود والملف لكي يتسنى لكم مساعدتي لطفا الرقم السري للملف tareq972708 Private Sub CommandButton1_Click() On Error Resume Next Dim i As Integer, LastR As Long, ws, ws1 As Worksheet Set ws = ThisWorkbook.Sheets("البيانات") Set ws1 = ThisWorkbook.Sheets("المدراء") LastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row + 1 LastRow1 = ws1.Cells(Rows.Count, "B").End(xlUp).Row + 1 For i = 2 To 15 UserForm1.ComboBox1.Clear For T = 2 To LastRow If OptionButton1.Value = True Then If TextBox1.Text = Mid(ws1.Cells(S, 3).Text, 1, Len(TextBox1.Text)) Then UserForm1.ComboBox1.AddItem ws1.Cells(S, 3) UserForm1.Controls("TextBox" & i).Value = ws1.Cells(S, i).Value UserForm1.CommandButton4.Enabled = True Unload Me End If Else If OptionButton2.Value = True Then If TextBox1.Text = Mid(ws.Cells(T, 3).Text, 1, Len(TextBox1.Text)) Then UserForm1.ComboBox1.AddItem ws.Cells(T, 3) UserForm1.Controls("TextBox" & i).Value = ws.Cells(T, i).Value UserForm1.CommandButton4.Enabled = True Unload Me End If End If End If Next Next UserForm1.ComboBox1.ListIndex = 0 If UserForm1.TextBox2.Text = "" Then MsgBox "åÐÇ ÇáãæÙÝ ÛíÑ ãæÌæÏ", vbInformation + vbMsgBoxRight, "äÊíÌÉ ÇáÈÍË" UserForm1.CommandButton3.Enabled = False End Sub 2017صيفية برمجية استعلام.rar

اخي الكريم اشكر جهودك ولكن لم يحدث التغيير المطلوب لذلك ارفق لك الملف لكي تكون الصورة اوضح لك علما باني اجريت التعديلات التي طلبتها الرقم السري هو tareq972708 2017صيفية برمجية استعلام.rar

حسب فهمي لكلامك عملت الكود على الشكل التالي ولم يستجيب ارجو منك معرفة الخطأ الذي وقعت فيه Private Sub CommandButton1_Click() On Error Resume Next Dim i As Integer, LastR As Long, ws As Worksheet Set ws1 = ThisWorkbook.Sheets("البيانات1") Set ws2 = ThisWorkbook.Sheets("البيانات2") LastRow1 = ws.Cells(Rows.Count, "B").End(xlUp).Row + 1 LastRow2 = ws.Cells(Rows.Count, "B").End(xlUp).Row + 1 For i = 2 To 17 UserForm1.ComboBox1.Clear For T = 2 To LastRow If OptionButton1.Value = True Then If TextBox1.Text = Mid(ws.Cells(T, 2).Text, 1, Len(TextBox1.Text)) Then UserForm1.ComboBox1.AddItem ws.Cells(T, 3) UserForm1.Controls("TextBox" & i).Value = ws.Cells(T, i).Value UserForm1.CommandButton4.Enabled = True Unload Me End If Else If OptionButton2.Value = True Then If TextBox1.Text = Mid(ws.Cells(T, 3).Text, 1, Len(TextBox1.Text)) Then UserForm1.ComboBox1.AddItem ws.Cells(T, 3) UserForm1.Controls("TextBox" & i).Value = ws.Cells(T, i).Value UserForm1.CommandButton4.Enabled = True Unload Me End If End If End If Next Next UserForm1.ComboBox1.ListIndex = 0 If UserForm1.TextBox2.Text = "" Then MsgBox "هذا الموظف غير موجود", vbInformation + vbMsgBoxRight, "نتيجة البحث" UserForm1.CommandButton3.Enabled = False End Sub

للرفع ....رفع الله مقامكم

كل الشكر 100% احترامي لك اخي الكريم والى اخي ابو علي

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

للرفع...

اخواني ارفق كود للبحث واريد ان يبحث في صفحتين اسماء الصفحات موجودة في الكود ولكنه يبحث فقط في الصفحة التي اسمها (المدراء) ويتجاهل الصفحة التي اسمها (البيانات) Private Sub CommandButton1_Click() On Error Resume Next Dim i As Integer, LastR As Long, ws As Worksheet Set ws = ThisWorkbook.Sheets("البيانات") Set ws = ThisWorkbook.Sheets("المدراء") LastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row + 1 For i = 2 To 15 UserForm1.ComboBox1.Clear For T = 2 To LastRow If OptionButton1.Value = True Then If TextBox1.Text = Mid(ws.Cells(T, 2).Text, 1, Len(TextBox1.Text)) Then UserForm1.ComboBox1.AddItem ws.Cells(T, 3) UserForm1.Controls("TextBox" & i).Value = ws.Cells(T, i).Value UserForm1.CommandButton4.Enabled = True Unload Me End If Else If OptionButton2.Value = True Then If TextBox1.Text = Mid(ws.Cells(T, 3).Text, 1, Len(TextBox1.Text)) Then UserForm1.ComboBox1.AddItem ws.Cells(T, 3) UserForm1.Controls("TextBox" & i).Value = ws.Cells(T, i).Value UserForm1.CommandButton4.Enabled = True Unload Me End If End If End If Next Next UserForm1.ComboBox1.ListIndex = 0 If UserForm1.TextBox2.Text = "" Then MsgBox "åÐÇ ÇáãæÙÝ ÛíÑ ãæÌæÏ", vbInformation + vbMsgBoxRight, "äÊíÌÉ ÇáÈÍË" UserForm1.CommandButton3.Enabled = False End Sub Private Sub CommandButton2_Click() Unload Me End Sub Private Sub Label1_Click() End Sub Private Sub Label2_Click() End Sub Private Sub OptionButton1_Click() TextBox1.Enabled = True TextBox1.SetFocus End Sub Private Sub OptionButton2_Click() TextBox1.Enabled = True TextBox1.SetFocus End Sub Private Sub TextBox1_Change() If TextBox1.Text = "" Then CommandButton1.Enabled = False Else CommandButton1.Enabled = True End If End Sub

السلام عليكم ارفق امر الترحيل التالي واريد عند الترحيل كل مرة لا تنسخ البيانات التي تم ترحيها على نفس الخلايا المذكورة بالكود بل تسلسل تحتها وهكذا Private Sub CommandButton11_Click() Dim SH As Worksheet Set SH = ThisWorkbook.Sheets("المدراء (2)") Workbooks.Application.Visible = True Application.ScreenUpdating = False With SH .Activate .[b4].Value = TextBox2.Value .[c4].Value = TextBox3.Value .[d4].Value = TextBox4.Value .[e4].Value = TextBox5.Value .[f4].Value = TextBox6.Value .[g4].Value = TextBox7.Value .[h4].Value = TextBox8.Value .[i4].Value = TextBox9.Value .[j4].Value = TextBox10.Value .[k4].Value = TextBox11.Value .[l4].Value = TextBox12.Value .[m4].Value = TextBox13.Value .[n4].Value = TextBox14.Value .[o4].Value = TextBox15.Value .[p4].Value = TextBox16.Value .[q4].Value = TextBox17.Value End With Application.ScreenUpdating = True End Sub

كل شكر والتقدير 100% بارك الله فيك ..........