تصحيح كود الاستعلام

[2saad]

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

لدي ملف به فورم لما افتح الفورم واختار اسم معين من ( التكست بوكس11 ) اللي امام البحث بالاسم ثم استعلم عن بيانات الاسم يعطيني بيانات اسم شخص تاني 

فما الحل ؟محمد (1).xlsm

[2saad]

مفيش حل يا إخواني ؟

[محمد هشام.]

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

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

 

Private Sub CommandButton3_Click() ' بحث
Dim sh1 As Worksheet
Dim f As Range
Set sh1 = Sheet54
lrw = sh1.Cells(Rows.Count, 5).End(xlUp).Row
  With TextBox11
    
      If .Value = "" Then MsgBox "من فضلك ادخل الاسم الذي تريد البحث عنه يا عم سعد", vbCritical, "تنبيه يا عم سعد": Exit Sub
    Set f = sh1.Range("E5:E" & lrw).Find(TextBox11.Value, , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      TextBox1.Value = sh1.Range("C" & f.Row).Value
      TextBox2.Value = sh1.Range("D" & f.Row).Value
      TextBox3.Value = sh1.Range("E" & f.Row).Value
      TextBox4.Value = sh1.Range("F" & f.Row).Value
      TextBox5.Value = sh1.Range("G" & f.Row).Value
      TextBox6.Value = sh1.Range("H" & f.Row).Value
      TextBox7.Value = sh1.Range("I" & f.Row).Value
      TextBox8.Value = sh1.Range("J" & f.Row).Value
      TextBox9.Value = sh1.Range("K" & f.Row).Value
      TextBox10.Value = sh1.Range("L" & f.Row).Value
openpic = sh1.Range("M" & f.Row).Value
Me.Image1.Picture = LoadPicture(openpic)
Me.Image1.Visible = True
    Else
      MsgBox "الاسم غير موجود"
    End If
  End With
End Sub
''''''''''''''''''''''''''
Private Sub CommandButton2_Click() ' اظافة
Dim ws As Worksheet: Set ws = Sheet54
Dim lastrow As Long
lastrow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
With ws
    ligne = .Cells(.Rows.Count, "C").End(xlUp).Row + 1
End With
   
   ws.Cells(ligne, 4) = Me.TextBox2.Text
   ws.Cells(ligne, 5) = Me.TextBox3.Text
   ws.Cells(ligne, 6) = Me.TextBox4.Text
   ws.Cells(ligne, 7) = Me.TextBox5.Text
   ws.Cells(ligne, 8) = Me.TextBox6.Text
   ws.Cells(ligne, 9) = Me.TextBox7.Text
   ws.Cells(ligne, 10) = Me.TextBox8.Text
   ws.Cells(ligne, 11) = Me.TextBox9.Text
   ws.Cells(ligne, 12) = Me.TextBox10.Text
 ws.Range("C10").Value = 1
 With ws.Range("C10:C" & lastrow)
        .Formula = "=Row() - 9"
        .Value = .Value
    End With
   For I = 1 To 11
    Me("Textbox" & I) = ""
  Next I
   MsgBox "تم حفظ البيانات بنجاح يا عم سعد", vbInformation, "تنبيه يا عم سعد"

   
End Sub
'''''''''''''''''''''''''''''''''''''
Private Sub ListBox1_Click()
Me.TextBox11.Value = Me.ListBox1.Column(0)
Me.ListBox1.Visible = False
End Sub
Private Sub TextBox11_Change()  'الى الليست بوكس' جلب جملة البحث
If Me.TextBox11.Text = "" Then
Me.ListBox1.Visible = False
Else
Me.ListBox1.Visible = True
Me.ListBox1.Clear
'------------------------------
Dim lrw
Set W = Sheet54
lrw = W.Cells(Rows.Count, 5).End(xlUp).Row
l = 0
For Each c In Range("e10:e" & lrw)
If c Like TextBox11.Text & "*" Then
ListBox1.AddItem
ListBox1.List(l, 0) = Cells(c.Row, 5).Value
l = l + 1
End If
Next c
End If
End Sub
Private Sub TextBox11_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  If Not iGblInhibitTextBoxEvents Then
  TextBox11.Value = ""
  End If
End Sub

 

محمد (2).xlsm

تم تعديل سبتمبر 15, 2023 بواسطه محمد هشام.

[2saad]

شكرا جزيلا يا استاذ محمد ويارك الله فيك

لو سمحت كمل جميلك واضف كود الحذف والتعديل

أنا بتعب حضرتك معاي