اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

اريد اضافة في الفروم


الردود الموصى بها

السلام عليكم ورحمة الله وبركاته 

اسعد الله اوقاتكم بكل خير يارب 

 

عندي فرم من اول والان اضفت عليه تعديلات ارقام التواصل والايميل 

 

واريد عند البحث تظهر البيانات 

 

علما في برنامج الاكسل 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

 

 

22.JPG

التقاط.JPG

رابط هذا التعليق
شارك

السلام عليكم ورحمة الله

ماذا تعني بـ "تبع TextBox10" و "تبع TextBox11"؟ هي الأكواد نفسها حرف بحرف... ثم إن الإضافة التي تريدها تكون في كود الفورم ذاته... يرجى إرفاق الملف المعني وليس صورة للأكواد أو الفورم...

بن علية حاجي 

رابط هذا التعليق
شارك

1 ساعه مضت, احمد بدره said:

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

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information