مطلوب برنامج كامل يحتوي على فورم للطباعة و واخر لادخال البيانات

فلاح الجبوري · يونيو 16, 2024

السلام عليكم اخواني انا عضو جديد معكم

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

بحيث عندما اكتب الاسم في خانة البحث تظهر كافة معلوماته

النطاق 500 موظف وبعثت مجموعة بيانات جديدة ممكن تشوفه لو تكرمت

اعرف ان طلبي كثير لكن املي بكم اكبر

فلاح.xlsx

**محمد هشام.** · يونيو 16, 2024

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

يصعب الاشتغال على ملف فارغ لا يتضمن اي بيانات

حاول اخي الكريم تصمييم الفورم الخاص بك اولا مع اظافة بعض البيانات الوهمية على الملف

1) مكان اظهار بيانات البحث هل على ليست بوكس او عناصر التيكست بوكس مثلا..........

2) توضيح البيانات المرغوب طباعتها مع تحديد النطاق

لا يمكن الاشتغال على التخمين

اين هو اخي اليوزرفورم الخاص بك ؟

تم تعديل يونيو 16, 2024 بواسطه محمد هشام.

فلاح الجبوري · يونيو 17, 2024

كل عام وانتم بخير بمناسبة عيد الاضحى المبارك ارجو منكم مساعدتي في عملي محتاج الى واجهة ادخال كما هو موضح لكم الى 500 موظف

New ورقة عمل Microsoft Excel.xlsm

**محمد هشام.** · يونيو 18, 2024

جرب هل هدا ما تقصده

Sub TEST()
Dim WS As Worksheet: Dim F As Worksheet
Set WS = Sheets("ورقة2"): Set F = Sheets("ورقة3")
 Application.ScreenUpdating = False
 F.Range("B" & F.Rows.Count).End(xlUp).Offset(1).Resize(, _
 26).Value = Application.Index(WS.Range _
   ("D5,C7,C9,C11,D13,E15,D17,D19,D21,J7,J9,J11,J13,J15,J17,I19,K19,J21,O7,O9,O11,N13,N15,N17,O19,O21"), _
        1, 1, Array(2, 3, 1, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, _
             14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26))
With F.Range("A4:A" & F.Cells(Rows.Count, "B").End(xlUp).Row)
    .Value = Evaluate("ROW(" & .Address & ")-3")
    End With
    Application.ScreenUpdating = True
    MsgBox "تم ترحيل البيانات بنجاح"
End Sub

New ورقة عمل Microsoft Excel 2.xlsm

فلاح الجبوري · يونيو 18, 2024

اخي العزيز من فضلك ممكن تراجع لي هذا الشيت اكون ممنون منك جدا

الاسم لا يظهر ومشاكل اخرى

123.xlsm

**محمد هشام.** · يونيو 18, 2024

هدا ملف مغاير اخي الكريم

على العموم تفضل هده الاكواد الخاصة بك بعد تعديلها

Private Sub CommandButton2_Click()
'بحث
    Dim WS As Worksheet, F As Worksheet, J As Long
    Dim rng As Range, LastRow As Long, Clé As String
    Set WS = Sheets("Sheet1"): Set F = Sheets("Sheet2"): Clé = WS.[E3]

    Application.ScreenUpdating = False
    If Clé = Empty Then: MsgBox "برجاء إدخال اسم للبحث عن بياناته", vbCritical, "فلاح": Exit Sub
    LastRow = F.Cells(F.Rows.Count, "B").End(xlUp).Row
    
    Set rng = F.Range("B3:B" & LastRow).Find(Clé, LookIn:=xlValues, _
          lookat:=xlWhole, SearchDirection:=xlPrevious)
If rng Is Nothing Then
    MsgBox " الاسم غير موجود", vbExclamation, Clé
 Else
  J = rng.Row
WS.[D5].Value = F.Cells(J, 2).Value:   WS.[D7].Value = F.Cells(J, 3).Value
WS.[D9].Value = F.Cells(J, 4).Value:   WS.[D11].Value = F.Cells(J, 5).Value
WS.[D13].Value = F.Cells(J, 6).Value:  WS.[D15].Value = F.Cells(J, 7).Value
WS.[D17].Value = F.Cells(J, 8).Value:  WS.[D19].Value = F.Cells(J, 9).Value
WS.[D21].Value = F.Cells(J, 10).Value: WS.[D23].Value = F.Cells(J, 11).Value
WS.[G7].Value = F.Cells(J, 12).Value:  WS.[G9].Value = F.Cells(J, 13).Value
WS.[G11].Value = F.Cells(J, 14).Value: WS.[G13].Value = F.Cells(J, 15).Value
WS.[G15].Value = F.Cells(J, 16).Value: WS.[G17].Value = F.Cells(J, 17).Value
WS.[G19].Value = F.Cells(J, 18).Value: WS.[G21].Value = F.Cells(J, 19).Value
WS.[G23].Value = F.Cells(J, 20).Value
  
  Application.ScreenUpdating = True
  End If
End Sub

اما بالنسبة لكود التعديل يمكنك اتمامه بنفس الطريقة

Private Sub CommandButton5_Click()
'تعديل
Dim WS As Worksheet, WS2 As Worksheet
Dim LastRow As Long, i As Long
Set WS = Sheets("Sheet2"): Set WS2 = Sheets("Sheet1")
LastRow = WS.Cells(WS.Rows.Count, 2).End(xlUp).Row
For i = 3 To LastRow
If WS.Range("B" & i).Value = WS2.[E3] Then
WS.Range("B" & i) = WS2.Range("D5")
WS.Range("C" & i) = WS2.Range("D7")
WS.Range("D" & i) = WS2.Range("D9")
WS.Range("E" & i) = WS2.Range("D11")
WS.Range("F" & i) = WS2.Range("D13")
'اتمم الكود
''''''''''''''''''''
''''''''''''''''''''


MsgBox "تم تعديل البيانات بنجاح"
   End If
 Next i
Application.ScreenUpdating = True
End Sub

123.xlsm

تم تعديل يونيو 18, 2024 بواسطه محمد هشام.
تعديل الكود

فلاح الجبوري · يونيو 19, 2024

احسنت اخي الغالي شكرا لك

فلاح الجبوري · يونيو 20, 2024

انا خجلان منك جدا اخي العزيز لكن عند اكمال البرنامج تظهر المعلومات بغير مكانها

123.xlsm

**محمد هشام.** · يونيو 20, 2024

لديك اخطاء في تحديد اسماء الخلايا كما في الصورة المرفقة

تم تعديل الكود ليسهل التعامل معه

Private Sub CommandButton2_Click()
'بحث
    Dim WS As Worksheet, F As Worksheet
    Dim Irow As Long, Clé As String, i As Long
    Set WS = Sheets("Sheet2"): Set F = Sheets("Sheet1"): Clé = F.[E3]

    Application.ScreenUpdating = False
    If Clé = Empty Then: MsgBox "برجاء إدخال اسم للبحث عن بياناته", vbCritical, "فلاح": Exit Sub
    Irow = WS.Cells(WS.Rows.Count, "B").End(xlUp).Row

Set rng = WS.Range("B3:B" & Irow).Find(Clé, LookIn:=xlValues, _
                     lookat:=xlWhole, SearchDirection:=xlPrevious)

If rng Is Nothing Then: MsgBox " الاسم غير موجود", vbExclamation, Clé: Exit Sub
For i = 3 To Irow
If WS.Cells(i, 2) = Clé Then
' Colmun (D)
F.[D5] = WS.Cells(i, "B")
F.[D7] = WS.Cells(i, "C"):    F.[D9] = WS.Cells(i, "D"):    F.[D11] = WS.Cells(i, "E")
F.[D13] = WS.Cells(i, "F"):   F.[D15] = WS.Cells(i, "G"):  F.[D17] = WS.Cells(i, "H")
F.[D19] = WS.Cells(i, "I"):   F.[D21] = WS.Cells(i, "J"):  F.[D23] = WS.Cells(i, "K")
' Colmun (G)
F.[G7] = WS.Cells(i, "L"):    F.[G9] = WS.Cells(i, "M"):   F.[G11] = WS.Cells(i, "N")
F.[G13] = WS.Cells(i, "O"):   F.[G15] = WS.Cells(i, "P"):  F.[G17] = WS.Cells(i, "Q")
F.[G19] = WS.Cells(i, "R"):   F.[G21] = WS.Cells(i, "S"):  F.[G23] = WS.Cells(i, "T")
' Colmun (J)
F.[J7] = WS.Cells(i, "U")
F.[J9] = WS.Cells(i, "V"):   F.[J11] = WS.Cells(i, "W")
F.[J13] = WS.Cells(i, "X"):   F.[J15] = WS.Cells(i, "Y")
    End If
  Next
  Application.ScreenUpdating = True
End Sub

مع تعديل كود الترحيل بالشكل التالي

Private Sub CommandButton1_Click()
' اظافة
Dim WS As Worksheet: Dim F As Worksheet
Set WS = Sheets("Sheet1"): Set F = Sheets("Sheet2")
 Application.ScreenUpdating = False
 F.Range("B" & F.Rows.Count).End(xlUp).Offset(1).Resize(, _
 24).Value = Application.Index(WS.Range _
   ("D5,D7,D9,D11,D13,D15,D17,D19,D21,D23,G7,G9,G11,G13,G15,G17,G19,G21,G23,J7,J9,J11,J13,J15"), _
        1, 1, Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, _
             14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26))
With F.Range("A3:A" & F.Cells(Rows.Count, "B").End(xlUp).Row)
    .Value = Evaluate("ROW(" & .Address & ")-2")
    End With
    Lr = F.Range("A65500").End(xlUp).Row
    b = F.Cells(2, F.Columns.Count).End(xlToLeft).Column
    F.Range(F.Cells(3, 1), F.Cells(Lr, b)).Borders.Weight = xlThin
    ' افراغ
CommandButton4_Click
Application.ScreenUpdating = True
    MsgBox "تم اضافة البيانات بنجاح"
End Sub

123 (1).xlsm

تم تعديل يونيو 21, 2024 بواسطه محمد هشام.

فلاح الجبوري · يوليو 10, 2024

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

استاذ محمد اعرف اني ازعجك بطلباتي ولكنني اتعلم منك واتمنى المزيد

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

علما ان الشيت 1000 اسم

فكرة مشروع.xlsx

**محمد هشام.** · يوليو 11, 2024

5 ساعات مضت, فلاح الجبوري said:

البحث بالاسم الاول في خانة الاسماء

اخي هدا طلب مختلف لا علاقة له بهدا الموضوع حاول فتح موضوع جديد بطلبك مع مزيدا من التوضيح او ارفاق عينة للنتائج المتوقعة وان شاء الله سنحاول مساعدتك

تسجيل الدخول

مطلوب برنامج كامل يحتوي على فورم للطباعة و واخر لادخال البيانات

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

فلاح الجبوري

محمد هشام.

فلاح الجبوري

محمد هشام.

فلاح الجبوري

محمد هشام.

فلاح الجبوري

فلاح الجبوري

محمد هشام.

فلاح الجبوري

محمد هشام.

تصفح الموقع

تصفح جديد الموقع

Support

Important Information