تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
تعديل كود البحث فى عدة صفحات من خلال الكمبوبوكس داخل الفورم
#1

.rar   برنامج_الشركة_2018-2019_الجديد.rar (الحجم : 982.92 ك ب / التحميلات : 57) السلام عليكم اهل المنتدى الكرام ارجو التكرم على مساعدتى فى تعديل كود الفورم الموجود بالملف لكى يتم البحث فى كل الصفحات من خلال الكمبوبوكس لكى يساعدنى ذلك فى اضافة وتعديل وحذف البيانات الى جميع الصفحات وذلك من خلال اليوزرفورم
كود :
' Dim r, i As Integer
Private Sub ComboBox1_Change()
On Error Resume Next
Dim ws As Worksheet
Set ws = Sheets("ÇáÈíÇäÇÊ")
Me.TextBox13.Value = WorksheetFunction.VLookup(Val(Me.ComboBox1.Value), ws.Range("A2:G1000"), 2, 0)
Me.TextBox14.Value = WorksheetFunction.VLookup(Val(Me.ComboBox1.Value), ws.Range("A2:G1000"), 3, 0)
Me.TextBox15.Value = WorksheetFunction.VLookup(Val(Me.ComboBox1.Value), ws.Range("A2:G1000"), 4, 0)
Me.TextBox16.Value = WorksheetFunction.VLookup(Val(Me.ComboBox1.Value), ws.Range("A2:G1000"), 5, 0)
Me.TextBox17.Value = WorksheetFunction.VLookup(Val(Me.ComboBox1.Value), ws.Range("A2:G1000"), 6, 0)
Me.TextBox18.Value = WorksheetFunction.VLookup(Val(Me.ComboBox1.Value), ws.Range("A2:G1000"), 7, 0)
End Sub
Private Sub CommandButton1_Click()
For j = 1 To 6
        Cells(r, j) = Controls("TextBox" & j).Text
Next j
ListBox1.List(i, 0) = TextBox2.Text
End Sub
Private Sub CommandButton2_Click()
If Me.ComboBox1.Value = "" Then
MsgBox "ÚÝæÇ íÌÈ ÇÎÊÇÑ ÇáÔíÊ ÇáãÑÍá Çáíå ÇáÈíÇäÇÊ"
Exit Sub
End If
Worksheets(Me.ComboBox1.Value).Activate
Dim lastrow
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastrow = lastrow + 1
Cells(lastrow, 1) = Me.TextBox1.Value
Cells(lastrow, 2) = Me.TextBox2.Value
Cells(lastrow, 3) = Me.TextBox3.Value
Cells(lastrow, 4) = Me.TextBox4.Value
Cells(lastrow, 5) = Me.TextBox5.Value
Cells(lastrow, 6) = Me.TextBox6.Value
Cells(lastrow, 7) = Me.TextBox7.Value
Cells(lastrow, 8) = Me.TextBox8.Value
Cells(lastrow, 9) = Me.TextBox9.Value
Cells(lastrow, 10) = Me.TextBox10.Value
Cells(lastrow, 11) = Me.TextBox11.Value
Cells(lastrow, 12) = Me.TextBox12.Value
  TextBox1.Value = Application.WorksheetFunction.Max(ActiveSheet.Range("A15:A44")) + 1
TextBox2.SetFocus
End Sub
Private Sub CommandButton3_Click()
If MsgBox("ÓíÊã ÇáÍÐÝ åá ÃäÊ ãÊÃßÏ¿", vbQuestion + vbYesNo) = vbYes Then
Sheets(1).Cells(r, 1).EntireRow.Delete
For Z = 1 To 6
Sheets(1).Cells(r, Z).Delete Shift:=xlUp
Next Z
Sheets(1).Cells(r, 1).Resize(r, 6).Delete Shift:=xlUp
MsgBox "ÊãÊ ÚãáíÉ ÇáÍÐÝ ÈäÌÇÍ"
For y = 1 To 6
'Controls("Textbox" & y).Text = ""
Next y
ListBox1.Clear
UserForm_Activate
TextBox7 = ""
End If
End Sub

Private Sub CommandButton4_Click()
Me.PrintForm
End Sub

Private Sub CommandButton5_Click()
End
End Sub
Private Sub CommandButton6_Click()
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
TextBox8.Text = ""
TextBox9.Text = ""
TextBox10.Text = ""
TextBox11.Text = ""
TextBox12.Text = ""
TextBox13.Text = ""
TextBox14.Text = ""
TextBox15.Text = ""
TextBox16.Text = ""
TextBox17.Text = ""
TextBox18.Text = ""
End Sub
Private Sub ListBox1_Click()
For i = 0 To ListBox1.ListCount
   If ListBox1.Selected(i) = True Then
       For j = 1 To 6
       Controls("TextBox" & j).Text = Cells(ListBox1.List(i, 1), j)
       Next j
       r = ListBox1.List(i, 1)
       Exit For
   End If
Next i
End Sub
Private Sub ListBox2_Click()
TextBox1.Value = ListBox2.Column(0)
TextBox2.Value = ListBox2.Column(1)
TextBox3.Value = ListBox2.Column(2)
TextBox4.Value = ListBox2.Column(3)
TextBox5.Value = ListBox2.Column(4)
TextBox6.Value = ListBox2.Column(5)
TextBox7.Value = ListBox2.Column(6)
TextBox8.Value = ListBox2.Column(7)
'TextBox9.Value = ListBox2.Column(8)
'TextBox10.Value = ListBox2.Column(9)
End Sub
Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
For i = 1 To 13
      Controls("Textbox" & i).Text = ""
Next i
TextBox1.Value = Application.WorksheetFunction.Max(Sheets(1).Range("A15:A44")) + 1
TextBox2.SetFocus
End Sub
Private Sub TextBox19_Change()
If TextBox19.Value = "" Then ListBox2.Clear: Exit Sub
Dim X As Worksheet
Set X = ActiveSheet

        ListBox2.Clear
   k = 0
       ss = X.Cells(Rows.Count, 13).End(xlUp).Row
       For Each c In X.Range("M15:M44" & ss)
           M = InStr(c, TextBox19)
           If M > 0 Then
               ListBox2.AddItem
               ListBox2.List(k, 0) = X.Cells(c.Row, 1).Value
               ListBox2.List(k, 1) = X.Cells(c.Row, 2).Value
               ListBox2.List(k, 2) = X.Cells(c.Row, 3).Value
               ListBox2.List(k, 3) = X.Cells(c.Row, 4).Value
               ListBox2.List(k, 4) = X.Cells(c.Row, 5).Value
               ListBox2.List(k, 5) = X.Cells(c.Row, 6).Value
               ListBox2.List(k, 6) = X.Cells(c.Row, 7).Value
               ListBox2.List(k, 7) = X.Cells(c.Row, 8).Value
               ListBox2.List(k, 8) = X.Cells(c.Row, 9).Value
               k = k + 1
           End If
       Next c
End Sub

Private Sub TextBox20_Change()

End Sub

Private Sub TextBox7_Change()
ListBox1.Clear
   For i = 1 To 6
           Controls("TextBox" & i).Text = ""
   Next i
   If TextBox7 = "" Then Exit Sub
   Sheets(1).Activate
   ss = Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row
    k = 0
         For Each c In Range("B2:B" & ss)
   If c Like TextBox7.Value & "*" Then
       ListBox1.AddItem
       ListBox1.List(k, 0) = Cells(c.Row, 2).Value
       ListBox1.List(k, 1) = c.Row
       k = k + 1
   End If
Next c
End Sub
Private Sub TextBox5_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox7.Value = ""
ListBox1.Clear
End Sub
Private Sub TextBox8_Change()
ListBox2.Clear
   For i = 1 To 6
           Controls("TextBox" & i).Text = ""
   Next i
   If TextBox8 = "" Then Exit Sub
   Sheets(1).Activate
   ss = Sheets(1).Cells(Rows.Count, 5).End(xlUp).Row
    k = 0
         For Each c In Range("E2:E" & ss)
   If c Like TextBox8.Value & "*" Then
       ListBox2.AddItem
       ListBox2.List(k, 0) = Cells(c.Row, 5).Value
       ListBox2.List(k, 1) = c.Row
       k = k + 1
   End If
Next c
End Sub
Private Sub UserForm_Activate()
TextBox7.SetFocus
For i = 2 To ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
ListBox1.AddItem
ListBox1.List(i - 2, 0) = Cells(i, 15).Value
 ListBox1.List(i - 2, 1) = i
     Next i
     For i = 1 To 12
           Controls("TextBox" & i).Text = ""
Next i
      TextBox1.Value = Application.WorksheetFunction.Max(Sheets(1).Range("A15:A44")) + 1
TextBox2.SetFocus
End Sub
ولكم جزيل الشكر بارك الله فيكم جميعا
الرد }}}
تم الشكر بواسطة:
#2
للرفع أكرمكم الله
الرد }}}
تم الشكر بواسطة:
#3
هل هناك حل لذلك جزاكم الله كل خير
الرد }}}
تم الشكر بواسطة:
#4
للرفع أكرمكم الله
الرد }}}
تم الشكر بواسطة:
#5
للرفع بارك الله فيكم
الرد }}}
تم الشكر بواسطة:
#6
للرفع لو تكرمتم
الرد }}}
تم الشكر بواسطة:
#7
هل هناك حل أكرمكم الله
الرد }}}
تم الشكر بواسطة:


التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم