عبدالله المجرب

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

السلام عليكم اخي فضل جرب المرفق ستقوم بتضليل العمود الذي تريد حت اخر رقم ثم اضغط الزر Sub Abu_Ahmed_Srt() On Error Resume Next x = Selection.Column Selection.Sort Key1:=Cells(2, x), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Cells(21, 2) = Cells(1, x) Cells(21, 3) = x - 1 End Sub عنوان العمود وترتيبه.rar

السلام عليكم ضع هذا الكود تحت الكود السابق بالضبط Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("C11:D26")) Is Nothing Then CommandButton1.Caption = "ترحيل" End If End Sub

ابو الحسن يمكنك تسجيل ميكرو بهذه التنسيقات ثم تطبيقها على باقي الملف

ما شاء الله كود عجيب ومعلومة جديدة كل ردودك درر والماس هل من مزيد يا الماستنا

اخي ايهاب في حدث فتح الملف ضع هذا الكود Private Sub Workbook_Open() Application.ScreenUpdating = False With SEARCH_4_DOC_SPECIAL .Label1.ForeColor = &HFF& .ListBox1.ForeColor = &HFF& .Label1.Caption = "بيانات الوثائق المنتهية الصلاحية" .TextBox1.Text = "إنتهت الصلاحية من" .Show End With Application.ScreenUpdating = True End Sub

السلام عليكم تم التثبيت الموقت لعموم الفائدة

حدد ما تريد بالضبط هل الصفوف افقية ام راسية وما حدود المدى

السلام عليكم جرب المرفق في هذا الموضوع فبه ما طلبت http://www.officena.net/ib/index.php?showtopic=33881

السلام عليكم اخي ايهاب انا ارى ان انسب برنامج لما تطلبه هو هذا http://www.officena.net/ib/index.php?showtopic=31695

. السلام عليكم حسب سياسة المنتدى يمنع منعاً باتاً وضع سيريل او كراك لاي برنامج

استبدل المعادلة الموجودة في الخانة D11 بهذه =IF(ورقة1!K3="";"";ورقة1!K3)

السلام عليكم تم عمل اللازم بخصوص الزر جرب المرفق BOOK.rar

جرب المرفق او ضع مرفق نزاهة.rar

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

وهذا موضوع به الكثير http://www.officena.net/ib/index.php?showtopic=39376

السلام عليكم جرب هذا الكود Sub Abu_Ahmed_Cmnt() ActiveCell.ClearComments x = InputBox("اكتب ما تريد هنا", "ادراج تعليق") ActiveCell.AddComment ActiveCell.Comment.Visible = False ActiveCell.Comment.Text Text:=" MISHO:" & Chr(10) & x ActiveCell.Select End Sub

بعد اذن الاخ ياسر اخي لان المرفق 2003 لن تعمل الدالة Countifs لذا تم الحل باستخدام الدالة SUMPRODUCT سيتم عد الطلاب لصف رقم 1 فقط عد البنات الراسبة بفصل رقم (1).zip

ما شاء الله شرح رائع وصوت اروع بارك الله فيك وبالفعل هذا من اهم الدروس واضيف الى المتغيرات هذا dim a1 as range وهذا يخص تعريف الخلايا او المدى والله اعلم

السلام عليكم لتنفيذ الكود بعد الاختيار ضع هذا الكود في حدث ورقة العمل Private Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False If Not Intersect(Target, Range("R2")) Is Nothing Then Dim cl As Range Range("B1:M1").EntireColumn.Hidden = True Set mytrng = Range("Abu_Alhassn") For Each cl In mytrng If cl.Value = Target.Value Then x = cl.Column: Exit For Next Cells(1, x).EntireColumn.Hidden = False End If Application.ScreenUpdating = True End Sub اما بخصوص الاظهار فبامكانك عمل هذا يدوياً عن طريق اختيار (تضليل من الاعلى ) للاعمدة ثم تختار اظهار ام تريدها في زر امر

ما شاء الله عليك استاذ طارق عمل محترف

السلام عليكم Sub Abu_Ahmed_Show() Application.ScreenUpdating = False Dim cl As Range Range("B1:M1").EntireColumn.Hidden = True Set mytrng = Range("Abu_Alhassn") For Each cl In mytrng If cl.Value = [R2].Value Then x = cl.Column: Exit For Next Cells(1, x).EntireColumn.Hidden = False End Sub جرب المرفق تقرير (1).rar

هل جربت وضع الكود في حدث التغيير ComboBox1_Change() بدل بعد التحديث ComboBox1_AfterUpdate()

السلام عليكم بعد اذن الاخ leprince2007 الرقم 21900 هو حاصل عدد الايام في 60 سنة ويمكن دمجة في المعادلة ليصبح هكذا =B3+(365*60)

السلام عليكم بعد إذن الاخ ابونصار (ما شاء الله عليه نشاط واضح) Sub Abu_Ahmed_Tjme3() Dim cl As Range For Each cl In Range("D7:D" & [D1500].End(xlUp).Row) If Len(cl.Value) > 12 Then GoTo 0 If cl.Value <> "" Then cl.Value = [E2].Value & " _ " & cl.Value 0 Next End Sub بدون الحاجة الى كود إضافي شاهد المرفق تجميع الخلايا في خلية واحدة.rar