29-11-18, 05:26 PM
برنامج_الشركة_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