فورم بحث واضافه وتعديل

[rauf]

السلام  عليكم

عندي شيت المرفق محتاج لي كتابه فيه اكواد البحث وتعديل و الحفظ واتمني اخفاء شيت قاعدة بيانات حتي لا يكون مرئ لي احد

وشكرا

 

منظومة-الشؤون-الادارية-لمكتب-البصمة.xlsm

[أبومروان]

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

كود اخفاء قاعده البيانات واظهار فورم1

Private Sub Workbook_Open()
Worksheets("Dbsheet").Visible = False

UserForm1.Show
End Sub

 

كود للترحيل

Dim lr As Long
   lr = WorksheetFunction.CountA("DbSheet").Range("A:a")
    
    Sheets("DbSheet").Cells(lr + 1, 1).Value = TextBox1
    Sheets("DbSheet").Cells(lr + 1, 2).Value = TextBox2
      Sheets("DbSheet").Cells(lr + 1, 3).Value = TextBox13
    Sheets("DbSheet").Cells(lr + 1, 4).Value = TextBox4
      Sheets("DbSheet").Cells(lr + 1, 5).Value = TextBox5
    Sheets("DbSheet").Cells(lr + 1, 6).Value = TextBox6

 

 

[rauf]

الموضوع  شكلة مش واضح مش فاهم ولا حاجة ف الكلام المكتوب فوق ولا  اعرف حتي اكتب كود اصلا

مش فاهم حاجة من كلامك 

انا عايز الشيت يكون شغل مابعرفش اكتب اكواد

ممكن تضيف الاكواد في الملف وترفعه استاذ @كريم نظيم

[أبومروان]

اتفضل ارجو ان يكون المطلوب

منظومة-الشؤون-الادارية-لمكتب-البصمى.xlsm

[rauf]

الملف لا يزال لا يعمل من حيث خاصية البحث لا تعمل كذلك

يظهر هذا الخطا 

كذلك عمليه التعديل او الحفظ لا تعمل بالملف 

[أبومروان]

يمكنك استخدام الكود التالي  Application.Visible = False 'إخفاء الاكسل

Application.Visible = True 'إظهار الاكسل

[rauf]

الملف لا يعمل اصلا يا اخي

خيارات البحث او الحفظ لا تعمل

كذلك كلمة حفظ في ملف صارت علامات استفهام لا يمكن بحث عن شئ معين في القاعدة ...

 

[محمد هشام.]

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

تفضل اخي 

اسم المستخدم : admin

كلمة المرور : 1989

Option Compare Text
Dim f, Rng, MH(), WS_Rng, DataRng  
Private Sub UserForm_Initialize()
   DataRng = "Tableau1"
   WS_Rng = Range(DataRng).Columns.Count
   MH = Range(DataRng).Resize(, WS_Rng + 1).Value
   For i = 1 To UBound(MH): MH(i, WS_Rng + 1) = i: Next i
   Me.ListBox1.List = MH
   Me.ListBox1.ColumnCount = WS_Rng + 1
   Me.ListBox1.ColumnWidths = "70;110;100;100;100"
   Me.ComboBox1.List = Application.Transpose(Range(DataRng).Offset(-1).Resize(1))
   Me.ComboBox1.ListIndex = 0
   Me.B.Caption = "فلترة ب:" & Me.ComboBox1

   Set d = CreateObject("scripting.dictionary")
   For i = 1 To UBound(MH)
     d(MH(i, 1)) = ""
   Next i
   WSdata = d.keys
   Me.ComboBox2.List = WSdata
   Sht = Application.Transpose(Range(DataRng).Offset(-1).Resize(1))
   For i = 1 To WS_Rng
     Me("label" & i) = Sht(i, 1)
   Next i
   For i = WS_Rng + 1 To 6
      Me("label" & i).Visible = False: Me("TextBox" & i).Visible = False
   Next i
   Me.ComboBox2 = "*"
   T_resultat = "عدد الموظفين" & "/" & ListBox1.ListCount + 0
   Count = ListBox1.ListCount
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Combobox1_click()
Me.ListBox1.List = MH
  Me.B.Caption = "فلترة ب:" & Me.ComboBox1
  Me.T.Caption = "بحث ب:" & Me.ComboBox1
  Set Titre = Range(DataRng).Offset(-1).Resize(1)
  colFiltre = Application.Match(Me.ComboBox1, Titre, 0)
  Set d = CreateObject("scripting.dictionary")
  For i = 1 To UBound(MH)
    d(MH(i, colFiltre)) = ""
  Next i
  WSdata = d.keys
  Me.ComboBox2.List = WSdata
  Me.ComboBox2 = Empty
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub TextBoxRech_Change()
 On Error Resume Next
  WSdest = Me.ComboBox1.ListIndex + 1
  clé = "*" & Me.TextBoxRech & "*": n = 0
  Dim Tbl()
  For i = 1 To UBound(MH)
    If MH(i, WSdest) Like clé Then
        n = n + 1: ReDim Preserve Tbl(1 To UBound(MH, 2), 1 To n)
        For k = 1 To UBound(MH, 2): Tbl(k, n) = MH(i, k): Next k
     End If
  Next i
  If n > 0 Then Me.ListBox1.Column = Tbl Else Me.ListBox1.clear
  
End Sub

 

منظومة-الشؤون-الادارية.xlsm

[rauf]

بسم الله ماشاء الله  شغل ممتاز ومتعوب عليه اخي العزيز بارك الله فيك وشكرا علي المساعدة

[elmansyeswa]

جعله الله فى ميزان حسناتك