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

[mhareek]

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

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

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

ولكم جزيل الشكر

الاكود هى كالاتى

تعمل على يوزر فورم كما تعلمون

Private Sub CommandButton1_Click()

End

End Sub

Private Sub UserForm_Activate()

Sheets("List").Cells(2, "e").Select

For i = 2 To Sheets("List").ER

cmb_Choose.AddItem (Sheets("List").Cells(i, "e"))

Next

End Sub

Private Sub cmb_Choose_Change()

For i = 2 To Sheets("List").ER

If cmb_Choose.Text = Sheets("List").Cells(i, "e").Text Then

txt_Name.Text = Sheets("List").Cells(i, "B").Text

txt_Company.Text = Sheets("List").Cells(i, "a").Text

txt_Category.Text = Sheets("List").Cells(i, "D").Text

TextBox1.Text = Sheets("List").Cells(i, "i").Text

TextBox2.Text = Sheets("List").Cells(i, "j").Text

TextBox3.Text = Sheets("List").Cells(i, "k").Text

TextBox6.Text = Sheets("List").Cells(i, "g").Text

TextBox5.Text = Sheets("List").Cells(i, "l").Text

TextBox7.Text = Date

TextBox34.Text = Time

If txt_Date_Graduated = "" Then

txt_Date_Dif = ""

Else

txt_Date_Dif = Month(txt_Date_Graduated)

End If

txt_Department.Text = Sheets("List").Cells(i, "F").Text

Sheets("List").Cells(i, "B").Select

Exit For

End If

Next

btn_Next.Enabled = True

btn_Next.Caption = " < "

btn_Last.Enabled = True

btn_Last.Caption = " > "

End Sub

Private Sub btn_Last_Click()

btn_Next.Enabled = True

btn_Next.Caption = " < "

ActiveCell.Offset(-1, 0).Select

My_Text

If ActiveCell = "الاسم" Then

btn_Last.Enabled = False

btn_Last.Caption = "First"

MsgBox "First"

End If

End Sub

Private Sub btn_First_Click()

Sheets("List").Cells(2, "B").Select

My_Text

End Sub

Private Sub btn_Next_Click()

btn_Last.Enabled = True

btn_Last.Caption = " > "

ActiveCell.Offset(1, 0).Select

My_Text

If ActiveCell = "" Then

btn_Next.Enabled = False

btn_Next.Caption = "Last"

MsgBox "LAST"

End If

End Sub

Private Sub btn_End_Click()

Sheets("List").Cells(Sheets("List").ER, "B").Select

My_Text

End Sub

Private Function My_Text()

txt_Name.Text = ActiveCell.Text

txt_Company.Text = ActiveCell.Offset(0, 1).Text

txt_Category.Text = ActiveCell.Offset(0, 2).Text

txt_Department.Text = ActiveCell.Offset(0, 4).Text

End Function

ارجو الاهتمام والمساعدة

للعلم هذا الاكود من عمل اساتذتى بهذا المنتدى الحبيب

الف شكر

[mhareek]

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

ارجو الاهتمام اخوانى الاحباب

[mhareek]

اخوانى الاحباب ارجو المساعدة الاهتمام

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

ارجو اخوانى الاحباب جزاكم الله خير التفاعل معى لما فية فائدة للجميع

ولكم جزيل الشكر