علي عاي قام بنشر أبريل 23, 2019 قام بنشر أبريل 23, 2019 السلام عليكم ورحمة الله وبركاته اسعد الله اوقاتكم بكل خير يارب عندي فرم من اول والان اضفت عليه تعديلات ارقام التواصل والايميل واريد عند البحث تظهر البيانات علما في برنامج الاكسل E رقم الهاتف و F الايميل E = TextBox10 في الفروم F =TextBox11 في الفروم -------------------------- تبع TextBox10 Private Sub CommandButton1_Click() Dim ws As Worksheet For Each ws In ThisWorkbook.Worksheets For Each f In ws.Range("a2:a1000") If f = TextBox1.Text Then ws.Select f.Select Exit For End If Next f Next ws For Each ws In ThisWorkbook.Worksheets ActiveCell.Value = TextBox1.Value ActiveCell.Offset(0, 1).Value = TextBox2.Value ActiveCell.Offset(0, 2).Value = TextBox3.Value ActiveCell.Offset(0, 3).Value = TextBox4.Value ActiveCell.Offset(0, 4).Value = TextBox5.Value ActiveCell.Offset(0, 5).Value = TextBox6.Value Next ws MsgBox "Êã ÊÚÏíá ÇáÈíÇäÇÊ ÈäÌÇÍ" TextBox1.Value = "" TextBox2.Value = "" TextBox3.Value = "" TextBox4.Value = "" TextBox5.Value = "" TextBox6.Value = "" TextBox8.Value = "" End Sub Private Sub CommandButton2_Click() Dim ws As Worksheet For Each ws In ThisWorkbook.Worksheets For Each f In ws.Range("a2:a1000") If f = TextBox1.Text Then ws.Select f.Select Exit For End If Next f Next ws ActiveCell.EntireRow.Delete End Sub Private Sub CommandButton3_Click() End End Sub Private Sub CommandButton10_Click() End End Sub Private Sub CommandButton9_Click() On Error Resume Next Application.Visible = True UserForm1.Hide Sheet1.Select End Sub Private Sub Label12_Click() End Sub Private Sub Label6_Click() End Sub Private Sub Label9_Click() End Sub Private Sub ListBox1_Click() TextBox1.Value = ListBox1.Column(0) TextBox2.Value = ListBox1.Column(1) TextBox3.Value = ListBox1.Column(2) TextBox4.Value = ListBox1.Column(3) End Sub Private Sub TextBox1_Change() End Sub Private Sub TextBox10_Change() End Sub Private Sub TextBox11_Change() End Sub Private Sub TextBox2_Change() End Sub Private Sub TextBox4_Change() End Sub Private Sub TextBox8_Change() ' TextBox1.Value = "" ' TextBox2.Value = "" ' TextBox3.Value = "" ' TextBox4.Value = "" ' TextBox7.Value = "" ' If TextBox8.Value = "" Then ListBox1.Clear: Exit Sub Dim x As Worksheet ListBox1.Clear k = 0 For Each x In ThisWorkbook.Worksheets ss = x.Cells(Rows.Count, 1).End(xlUp).Row For Each c In x.Range("a2:a" & ss) b = InStr(c, TextBox8) If b > 0 Then ListBox1.AddItem ListBox1.List(k, 0) = x.Cells(c.Row, 1).Value ListBox1.List(k, 1) = x.Cells(c.Row, 2).Value ListBox1.List(k, 2) = x.Cells(c.Row, 3).Value ListBox1.List(k, 3) = x.Cells(c.Row, 4).Value ListBox1.List(k, 4) = x.Cells(c.Row, 5).Value ListBox1.List(k, 5) = x.Cells(c.Row, 6).Value ' ListBox1.List(k, 6) = x.Cells(c.Row, 7).Value k = k + 1 End If Next c Next x End Sub Private Sub TextBox9_Change() If TextBox9.Value = "" Then ListBox1.Clear: Exit Sub Dim x As Worksheet ListBox1.Clear k = 0 For Each x In ThisWorkbook.Worksheets ss = x.Cells(Rows.Count, 1).End(xlUp).Row For Each c In x.Range("b2:b" & ss) b = InStr(c, TextBox9) If b > 0 Then ListBox1.AddItem ListBox1.List(k, 0) = x.Cells(c.Row, 1).Value ListBox1.List(k, 1) = x.Cells(c.Row, 2).Value ListBox1.List(k, 2) = x.Cells(c.Row, 3).Value ListBox1.List(k, 3) = x.Cells(c.Row, 4).Value ListBox1.List(k, 4) = x.Cells(c.Row, 5).Value ListBox1.List(k, 5) = x.Cells(c.Row, 6).Value ' ListBox1.List(k, 6) = x.Cells(c.Row, 7).Value k = k + 1 End If Next c Next x End Sub --------------- تبع TextBox11 ------ Private Sub CommandButton1_Click() Dim ws As Worksheet For Each ws In ThisWorkbook.Worksheets For Each f In ws.Range("a2:a1000") If f = TextBox1.Text Then ws.Select f.Select Exit For End If Next f Next ws For Each ws In ThisWorkbook.Worksheets ActiveCell.Value = TextBox1.Value ActiveCell.Offset(0, 1).Value = TextBox2.Value ActiveCell.Offset(0, 2).Value = TextBox3.Value ActiveCell.Offset(0, 3).Value = TextBox4.Value ActiveCell.Offset(0, 4).Value = TextBox5.Value ActiveCell.Offset(0, 5).Value = TextBox6.Value Next ws MsgBox "Êã ÊÚÏíá ÇáÈíÇäÇÊ ÈäÌÇÍ" TextBox1.Value = "" TextBox2.Value = "" TextBox3.Value = "" TextBox4.Value = "" TextBox5.Value = "" TextBox6.Value = "" TextBox8.Value = "" End Sub Private Sub CommandButton2_Click() Dim ws As Worksheet For Each ws In ThisWorkbook.Worksheets For Each f In ws.Range("a2:a1000") If f = TextBox1.Text Then ws.Select f.Select Exit For End If Next f Next ws ActiveCell.EntireRow.Delete End Sub Private Sub CommandButton3_Click() End End Sub Private Sub CommandButton10_Click() End End Sub Private Sub CommandButton9_Click() On Error Resume Next Application.Visible = True UserForm1.Hide Sheet1.Select End Sub Private Sub Label12_Click() End Sub Private Sub Label6_Click() End Sub Private Sub Label9_Click() End Sub Private Sub ListBox1_Click() TextBox1.Value = ListBox1.Column(0) TextBox2.Value = ListBox1.Column(1) TextBox3.Value = ListBox1.Column(2) TextBox4.Value = ListBox1.Column(3) End Sub Private Sub TextBox1_Change() End Sub Private Sub TextBox10_Change() End Sub Private Sub TextBox11_Change() End Sub Private Sub TextBox2_Change() End Sub Private Sub TextBox4_Change() End Sub Private Sub TextBox8_Change() ' TextBox1.Value = "" ' TextBox2.Value = "" ' TextBox3.Value = "" ' TextBox4.Value = "" ' TextBox7.Value = "" ' If TextBox8.Value = "" Then ListBox1.Clear: Exit Sub Dim x As Worksheet ListBox1.Clear k = 0 For Each x In ThisWorkbook.Worksheets ss = x.Cells(Rows.Count, 1).End(xlUp).Row For Each c In x.Range("a2:a" & ss) b = InStr(c, TextBox8) If b > 0 Then ListBox1.AddItem ListBox1.List(k, 0) = x.Cells(c.Row, 1).Value ListBox1.List(k, 1) = x.Cells(c.Row, 2).Value ListBox1.List(k, 2) = x.Cells(c.Row, 3).Value ListBox1.List(k, 3) = x.Cells(c.Row, 4).Value ListBox1.List(k, 4) = x.Cells(c.Row, 5).Value ListBox1.List(k, 5) = x.Cells(c.Row, 6).Value ' ListBox1.List(k, 6) = x.Cells(c.Row, 7).Value k = k + 1 End If Next c Next x End Sub Private Sub TextBox9_Change() If TextBox9.Value = "" Then ListBox1.Clear: Exit Sub Dim x As Worksheet ListBox1.Clear k = 0 For Each x In ThisWorkbook.Worksheets ss = x.Cells(Rows.Count, 1).End(xlUp).Row For Each c In x.Range("b2:b" & ss) b = InStr(c, TextBox9) If b > 0 Then ListBox1.AddItem ListBox1.List(k, 0) = x.Cells(c.Row, 1).Value ListBox1.List(k, 1) = x.Cells(c.Row, 2).Value ListBox1.List(k, 2) = x.Cells(c.Row, 3).Value ListBox1.List(k, 3) = x.Cells(c.Row, 4).Value ListBox1.List(k, 4) = x.Cells(c.Row, 5).Value ListBox1.List(k, 5) = x.Cells(c.Row, 6).Value ' ListBox1.List(k, 6) = x.Cells(c.Row, 7).Value k = k + 1 End If Next c Next x End Sub
بن علية حاجي قام بنشر أبريل 23, 2019 قام بنشر أبريل 23, 2019 السلام عليكم ورحمة الله ماذا تعني بـ "تبع TextBox10" و "تبع TextBox11"؟ هي الأكواد نفسها حرف بحرف... ثم إن الإضافة التي تريدها تكون في كود الفورم ذاته... يرجى إرفاق الملف المعني وليس صورة للأكواد أو الفورم... بن علية حاجي
علي عاي قام بنشر أبريل 24, 2019 الكاتب قام بنشر أبريل 24, 2019 للبحث عن شركات العمرة 2019 للتعديل اضافة ارقام التواصل.xlsm
احمد بدره قام بنشر أبريل 24, 2019 قام بنشر أبريل 24, 2019 جرب هذا التعديل __للبحث عن شركات العمرة 2019 للتعديل اضافة ارقام التواصل.xlsm
وجيه شرف الدين قام بنشر أبريل 24, 2019 قام بنشر أبريل 24, 2019 1 ساعه مضت, احمد بدره said: جرب هذا التعديل __للبحث عن شركات العمرة 2019 للتعديل اضافة ارقام التواصل.xlsm 116.79 \u0643\u064a\u0644\u0648 \u0628\u0627\u064a\u062a · 2 downloads تسلم يمينك استاذ احمد وزادكم الله علما ونفعنا بكم
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.