عبدالله باقشير

السلام عليكم الاخ/ الفاضل/ cat101-------حفظه الله تغير المعطيات اعلى الكود: 'رقم اول صف للشهادة Const FirstRow As Integer = 7 '------------------------------- 'عدد صفوف الشهادة Const CountRow As Integer = 11 '------------------------------- 'عدد اعمدة الشهادة التي تريد اظهارها في الطباعة Const CountColumn As Integer = 13 '------------------------------- Const Range_Index As String = "A7" ============================================== انظر الى المرفق استخراج شهادات بشرط3.rar ============================================== بالنسبة لظهور شهادتين يمكنك تغيير ارتفاع صف البداية للشهادة حتى تظهر لك شهادتين فقط او اضافة عدة صفوف اخرى للشهادة او تغيير هوامش الطباعة الاعلى / الاسفل اختار اي طريقة تريد ============================================= الاخ/ الفاضل/ ايمن ريا-------حفظه الله الاخ/ الفاضل/ tarek-------حفظه الله الاخ/ الفاضل/ asdhamady-------حفظه الله جزاكم الله الف خير تقبلوا تحياتي وشكري

السلام عليكم اخي / خالد القدس -------حفظه الله الله ينور طريقك ويعطيك على حسن نيتك اخي / ALKHALEDI -------حفظه الله فكرة رائعة وعمل يستحق الثناء تقبلا تحياتي وشكري

السلام عليكم بارك الله فيك اخي خالد القدس تفضل المرفق Hancock3.rar

السلام عليكم لاخ/ الفاضل/ يوسف عطا-------حفظه الله الاخ/ الفاضل/ cat101-------حفظه الله جزاكما الله الف خير تقبلوا تحياتي وشكري

السلام عليكم الله يعطيك بمثل دعائك اضعاف مضاعفة اكرمك الله تقبل تحياتي وشكري

السلام عليكم تفضل المرفق Hancock1.rar

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

السلام عليكم تفضل المرفق بحث.rar

السلام عليكم الاخ/ الفاضل/ mhrrd -------حفظه الله في المرفق تكملة المطلوب الفرز والبحث بالرقم السري ============================================ الاخ/ الفاضل/ سالم شباني -------حفظه الله الاخ/ الحبيب / محمدي عبد السميع-------حفظه الله الاخ/ الفاضل/ ناصر سعيد-------حفظه الله جزاكم الله الف خير تقبلوا تحياتي وشكري ================================== الاعتماد على آخر التعديلات في الملف الموجود في المشاركة رقم 18 استخراج شهادات بشرط2.rar

السلام عليكم الكود التالي موجود في حدث الورقة1 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub If Target.Address = "$A$1" Then If IsNumeric(Target) Then On Error Resume Next Application.EnableEvents = False Target = Target * 3 Application.EnableEvents = True On Error GoTo 0 End If End If End Sub تفضل المرفق TARGET.rar

السلام عليكم شاهد الرابط: My link

السلام عليكم طباعة الشهادات جميع الشهادات الناجحين دور ثاني طلب لاحدهم جعلته لتعم الفائدة ================================== الاعتماد على آخر التعديلات في الملف الموجود في المشاركة رقم 18 استخراج شهادات بشرط1.rar

السلام عليكم بارك الله فيك اخي الحبيب ابو عبدالله عمل رائع جدا تقبل تحياتي وشكري

يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للإغلاق

السلام عليكم اخي tark حفظه الله ده ملف مؤقت فقط لمعرفة صحة المعمول ------------------------------ الاخ / سيد عبدالرحمن حفظه الله اشياء كثيرة غامضة عندي ولا افهمها وقد توقفت عن العمل في هذا البرنامج منتظرا الشرح الوافي لما اسلفت ذكره مسبقا

السلام عليكم لم اتمكن من فتح الملف بعد التحميل

السلام عليكم جزاك الله خيراً حركات جميلة جدا تقبل تحياتي وشكري

السلام عليكم بارك الله فيك اخي الحبيب طارق رائع جدا في استخدامك للجداول المحورية -------------------------------- اخي الفاضل / ابو البراء ده كود الفرز حسب طلبك Sub kh_Sort() With Range("School") .Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal .Sort Key1:=Range("E2"), Order1:=xlDescending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal .Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortTextAsNumbers End With End Sub اما عن اختيار الصف ممكن بعملية التصفية بعد الفرز بالكود اعلاه تفضل المرفق Record_2010.rar

السلام عليكم شرح فيديو لعملية توسيط الخط في القائمة تفضل المرفق KH_SHEET.rar

السلام عليكم تفضل المرفق AdvFilterSearchWord.rar

السلام عليكم بعد اذن اخي حسن حفظه الله تفضل المرفق كيفية تحويل قيمة الأعمدة إلى الصفوف.rar

السلام عليكم ورحمة الله وبركاته أخي الفاضل/ أبوهاجر ------حفظه الله هلا يا غالي حفظك ربي من كل مكروه تقبل تحياتي

السلام عليكم جزاك الله خيرا تقبل تحياتي وشكري

السلام عليكم ضيف في الكود قبل السطر: rngTarget.Activate السطر التالي: rngTarget.Worksheet.Activate الكود بعد التعديل: Sub CopyPaste_All_Comments() Dim aComment() Dim rngTarget As Range Dim rngSource As Range On Error Resume Next Set rngSource = Application.InputBox("اختر النطاق المطلوب نسخ التعليقات منه", Type:=8) On Error GoTo 0 If rngSource Is Nothing Then Exit Sub For Each cell In rngSource Set xComment = cell.Comment If Not xComment Is Nothing Then x = x + 1 ReDim Preserve aComment(x) aComment(x) = cell.Comment.Text End If Next cell On Error Resume Next Set rngTarget = Application.InputBox("اختر أول خلية في النطاق المطلوب وضع التعليقات فيه", Type:=8) On Error GoTo 0 If rngTarget Is Nothing Then Exit Sub rngTarget.Worksheet.Activate rngTarget.Activate For x = 1 To UBound(aComment) ActiveCell.Offset(x - 1, 0).FormulaR1C1 = aComment(x) Next End Sub

السلام عليكم اضافة بسيطة يمكنك وضع شرط لتفادي خلو الخلية من التعليق مع مسح ما في العمود B بمثل هذا الكود Sub KH_START() Dim MyCell As Range Dim R As Integer Set MyCell = Range("A1:B10") With MyCell .Columns(2).ClearContents For R = 1 To .Rows.Count If Not .Range("A" & R).Comment Is Nothing Then .Range("B" & R).Value = .Range("A" & R).Comment.Text End If Next R End With End Sub