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

السلام عليكم بعد اذن المعلم الصامت ذو المكانة العالية بن عليه جرب هذا الكود Sub PRINT_ALL() Dim I As Integer For I = 9 To Sheets("التحضير اليومي").Range("b" & Rows.Count).End(xlUp).Row w = Sheets("التحضير اليومي").Cells(I, 2).Value [B7] = w ActiveWindow.SelectedSheets.PrintOut Copies:=1 Next I End Sub

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

اخي الفاضل وبعد اذن ابو نصار ارفق ملف افضل من وضع صورة

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

السلام عليكم اخي فضل جرب المرفق ستقوم بتضليل العمود الذي تريد حت اخر رقم ثم اضغط الزر 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