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

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

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

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

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

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

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

فلاح.xlsx

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

123.xlsm

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

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

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

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 بواسطه محمد هشام.
تعديل الكود

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

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

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

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

123.xlsm

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

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

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

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 بواسطه محمد هشام.

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

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

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

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

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

فكرة مشروع.xlsx

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

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

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

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

تسجيل الدخول

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

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

فلاح الجبوري

محمد هشام.

فلاح الجبوري

محمد هشام.

فلاح الجبوري

محمد هشام.

فلاح الجبوري

فلاح الجبوري

محمد هشام.

فلاح الجبوري

محمد هشام.

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

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

Support

Important Information