ابراهيم الحداد

السلام عليكم ورحمة الله استخدم المعادلة التالية =SUMPRODUCT(D6:D40;(E6:E40)-1)

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

السلام عليكم ورحمة الله اخى الكريم هذا ماحدث معى بالضبط و البحث اكتشفت ان الحرف الاول المكتوب على الشكل هو حرف الياء و ليس حرف الباء يعنى مكتوبة "يحث" و ليس "بحث" لذا ارجو منك اعادة كتابة النص على كل شكل من الاشكال الثلاثة مرة اخرى بصورة صحيحة حتى يعمل معك بصورة طيبة ياريت كوبى بيست حتى تضمن دقة كتابة النص و الله الموفق و المستعان

السلام عليكم ورحمة الله ضع الكود الاول فى موديول عادى Sub test() Dim sp As Shape Dim SN As String, SR As String SR = Sheet2.Range("B2").Text For Each sp In Sheet2.Shapes If sp.AutoShapeType = msoShapeHeart Then SN = sp.TextFrame.Characters.Text sp.Visible = False If SN Like "*" & SR & "*" Then sp.Visible = True Else sp.Visible = False End If End If 'Exit For Next End Sub وضع الكود الاخر فى حدث الورقة 2 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$B$2" Then Exit Sub Call test End Sub

السلام عليكم ورحمة الله استخدم الكود التالى بعد وضعه فى حدث ThisWorkBook دبل كليك على الخلية A1 فى كل مرة Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) If Target.Address <> "$A$1" Then Exit Sub On Error GoTo 1: For i = 1 To Sheets.Count If ActiveSheet.CodeName = Sheets(i).CodeName Then Sheets(i + 1).Activate Exit For End If Next 1: Exit Sub End Sub

السلام عليكم ورحمة الله استخدم هذا الكود لاظهار اليوزرقورم بدلا من الكود الموجود لديك واذا لزم الامر غير اسم اليوزر فورم فى الكود الجديد Sub ShowUserF() UserForm1.Show vbModeless End Sub

السلام عليكم ورحمة الله اجعل هذا السطر هكذا Sheets("سجل الصادر").Cells(EndRow + 1, 1).Value = EndRow - 1

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

السلام عليكم ورحمة الله الف مبروك خبيرنا الجديد استاذ / حسين تهنئة واجبة اليك و لادارة المنتدى على حسن الاختيار

السلام عليكم ورحمة الله يجب وضع اسماء الصور فى العمود "B" بجوار الارقام اليك الملف المعلومات المدنية.rar

السلام عليكم ورحمة الله جرب هذا الجدول T_Table.xlsm

السلام عليكم ورحمة الله و يمكنك ايضا ان تجرب هذا الملف ربما يفيدك توزيع رغبات2.xlsm

السلام عليكم ورحمة الله ربما يفيدك هذا الملف جدول صباحى.xlsm

السلام عليكم ورحمة الله استخدم هذا الكود وخصص له زر Sub TransData() Dim ws As Worksheet, Sh As Worksheet Dim LR As Long, ShName As String Set Sh = Sheets("Form") ShName = Sh.Range("B9") For Each ws In ThisWorkbook.Worksheets LR = ws.Range("A" & Rows.Count).End(xlUp).Row If ws.Name = ShName Then ws.Range("A" & LR + 1 & ":G" & LR + 1).Value = _ Application.Transpose(Sh.Range("B2:B8").Value) End If Next Application.CutCopyMode = False End Sub ترحيل البيانات من نموذج تسجيل الى جميع الصفحات بإسم الصفحة.xlsm

السلام عليكم ورحمة الله اخى الكريم فتحى ابو الفضل الحقيقة ان الملف كبير جدا و حاولت معرفة سبب الخطأ و هو خطأ واحد ترتب عيه عدة اخطاء فى الشيتات المرتبطة بشيت الخطأ الاول حيث ان الصفين السابع و الثامن الوحيدين المرتبطين بخلية فى الاعمدة الاخيرة ومن المرجح ان هذا هو سبب الخطأ حيث لا توجد اخطاء فى باقى الصفوف مع العلم اننى عندما قمت بتجريب الكود مرة اخرى و حدث الخطأ فقمت بإغلاق الملف بدون حفظ و اعدت الكرة مرة اخرى تمت المهمة بنجاح بغرابة شديدة لهذا اعتذر عن تقديم تفسير مناسب لتلك الظاهرة لى طلب بسيط ان نمسح من الكود الاوامر الخاصة بالترقيم و استخدام هذه المعادلة بدلا منها كما هى : =IF(B7="";"";SUBTOTAL(3;$B$7:B7)) ليصبح الكود بعد التعديل كالتالى : Sub DelRows() Dim Sh As Worksheet, Msg As String Dim Nam As String Dim i As Long, x As Long, LR As Long Application.ScreenUpdating = False t = Timer Nam = ActiveCell.Value Msg = MsgBox("من كافة الشيتات" & " " & Nam & " " & "هل تريد فعلا ازالة السيد / ", vbYesNo) For Each Sh In Worksheets(Array("ادخال بيانات 155", "بدلات 155", "نقابات 155", "استقطاعات 155", "جزاءات 155", "بيانات معلمين-1", "بيانات معلمين", "مرتب 155", "مرتب 155")) Sh.Unprotect ("fathy_100") LR = Sh.Range("B" & Rows.Count).End(xlUp).Row For i = LR To 7 Step -1 If IsEmpty(Nam) Then Exit Sub If Sh.Cells(i, 2) = Nam Then If Msg = vbYes Then On Error Resume Next Sh.Rows(i).Delete End If End If Next Sh.Protect Next MsgBox Round(Timer - t, 2) Application.ScreenUpdating = True End Sub