علي المصري

جرب الملف التالي لكي ترفق مرفق اضغط الملف باستخدام برنامج وينرار Book1.rar

أولا شكرا جزيلا استاذ سليم وعلى موضوعاتك التي افادتني كثيرا جزاك الله خيرا بالنسب للرد على السؤال : الجواب كالتالي If Target.Column = 6 Then الرقم 6 هنا هو رقم العمود يمكنك العد من اول عمود A برقم 1 إلى ان تصل للعمود الذي تريده واكتب الرقم بدل الرقم 6 يعني استبدل السطر If Target.Column = 6 Then بالسطر If Target.Column = 3 Or Target.Column = 6 Then

جرب الطريقة التالية Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column = 6 Then Cells(Target.Row, Target.Column).Offset(0, 1).Select End If End Sub حماية نطاق من الخلايا.rar

السلام عليكم ورحمة الله وبركاته بعد البحث وجدت دالة تقوم بعمل دالة Datedif ولكنها عبر محرر الاكواد وقمت بالتعديل عليها لتكون كود يمكن استخدامه عن طريق زر في الصفحة يوجد في المرفق الدالة الاصلية والكود بعد اجراء التعديلات الكود كالتالي Sub MyAge() Dim iYear, iMonth, iDay As Integer Dim dt As Date Dim sResult, sResult2, sResult3, rng, BirthDate As String Dim i As Integer For i = 2 To 22 '2 هي اول صف به تاريخ ميلاد مطلوب حساب عمره '22 أخر صف به تاريخ ميلاد مطلوب حساب عمره BirthDate = Sheet1.Range("B" & i) rng = Sheet1.Range("c1") 'الخلية المطلوب حساب العمر منها If Not IsDate(BirthDate) Then Exit Sub dt = CDate(BirthDate) 'تحويل قيمة الخلية إلى تاريخ If dt > rng Then Exit Sub iYear = Year(dt) iMonth = Month(dt) iDay = Day(dt) iYear = Year(rng) - iYear iMonth = Month(rng) - iMonth iDay = Day(rng) - iDay If Sgn(iDay) = -1 Then iDay = 30 - Abs(iDay) iMonth = iMonth - 1 End If If Sgn(iMonth) = -1 Then iMonth = 12 - Abs(iMonth) iYear = iYear - 1 End If sResult1 = iYear sResult2 = iMonth sResult3 = iDay Sheet1.Range("d" & i) = sResult1 Sheet1.Range("e" & i) = sResult2 Sheet1.Range("f" & i) = sResult3 'السطر التالي يمكن حذفه اذا اردت ان يكون العمر مقسم إلى 3 خلايا Sheet1.Range("c" & i) = sResult1 & " Year, " & sResult1 & " Month, " & sResult3 & " Day " Next i End Sub ملاحظة هامة sheet1 دا اسم الورقة في محرر الاكواد اذا اردت كتابة اسم الورقة كما سميتها في التبويب الخاص بها لابد ان تكتب كالتالي Worksheets("اسم الورقة الموجود في التبويب").range(..........) MyAge.rar ويمكن استخدام الدالة DateDif كما يلي ممكن تستخدم الدوال التالية =DATEDIF(B3;$C$1;"y") أو =IF(B3="";"";DATEDIF(B3;$C$1;"y")) لحساب السنة =DATEDIF(B3;$C$1;"ym") أو =IF(B3="";"";DATEDIF(B3;$C$1;"ym")) لحساب الشهر =DATEDIF(B3;$C$1;"md") أو =IF(B3="";"";DATEDIF(B3;$C$1;"md")) لحساب اليوم MyAge.rar

السلام عليكم ورحمة الله وبركاته بعد البحث وجدت تعريف لدالة تقوم محل datedif السابق ذكرها في الرد السابق فقمت بالعمل على هذه الدالة وحولتها إلى كود يتناسب مع المطلوب ارجو ان تنال اعجابكم Sub MyAge() Dim iYear, iMonth, iDay As Integer Dim dt As Date Dim sResult, sResult2, sResult3, rng, BirthDate As String Dim i As Integer For i = 2 To 22 '2 هي اول صف به تاريخ ميلاد مطلوب حساب عمره '22 أخر صف به تاريخ ميلاد مطلوب حساب عمره BirthDate = Sheet1.Range("B" & i) rng = Sheet1.Range("c1") 'الخلية المطلوب حساب العمر منها If Not IsDate(BirthDate) Then Exit Sub dt = CDate(BirthDate) 'تحويل قيمة الخلية إلى تاريخ If dt > rng Then Exit Sub iYear = Year(dt) iMonth = Month(dt) iDay = Day(dt) iYear = Year(rng) - iYear iMonth = Month(rng) - iMonth iDay = Day(rng) - iDay If Sgn(iDay) = -1 Then iDay = 30 - Abs(iDay) iMonth = iMonth - 1 End If If Sgn(iMonth) = -1 Then iMonth = 12 - Abs(iMonth) iYear = iYear - 1 End If sResult1 = iYear sResult2 = iMonth sResult3 = iDay Sheet1.Range("d" & i) = sResult1 Sheet1.Range("e" & i) = sResult2 Sheet1.Range("f" & i) = sResult3 'السطر التالي يمكن حذفه اذا اردت ان يكون العمر مقسم إلى 3 خلايا Sheet1.Range("c" & i) = sResult1 & " Year, " & sResult1 & " Month, " & sResult3 & " Day " Next i End Sub MyAge.rar

وليه الاكواد ممكن تستخدم الدوال التالية =DATEDIF(B3;$C$1;"y") أو =IF(B3="";"";DATEDIF(B3;$C$1;"y")) لحساب السنة =DATEDIF(B3;$C$1;"ym") أو =IF(B3="";"";DATEDIF(B3;$C$1;"ym")) لحساب الشهر =DATEDIF(B3;$C$1;"md") أو =IF(B3="";"";DATEDIF(B3;$C$1;"md")) لحساب اليوم Datedif.rar

جرب التعديل التالي تنسيق شرطي باستخدام دالة اف =IF(D8=فصل1!D8;FALSE;TRUE) applied to تطبيق على النطاق =$D$8:$AW$10 و =IF(AZ8=فصل2!D8;FALSE;TRUE) applied to تطبيق على النطاق =$AZ$8:$CS$10 سجل.rar

التاريخ جزء من اسم الملف الذي تم حفظه

Sub SaveAsPDF() Application.ScreenUpdating = False ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ ThisWorkbook.Path & "\" & ActiveSheet.Name & " " & "Grade " & Range("S1").Value & Range("T1").Value _ & " " & Format(Now, "mm-dd-yyyy hh mm' ss'' AM/PM"), Quality _ :=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False _ , OpenAfterPublish:=True Application.ScreenUpdating = True End Sub ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, هذا الامر الخاص بتصدير ملف الاكسيل الى ملف بي دي اف Filename:= اسم الملف الذي سيكون بعد الحفظ _ ThisWorkbook.Path & "\" & نفس مسار ملف الاكسيل الذي تريد التعامل معه ActiveSheet.Name اسم الورقة التي تريد حفظها & " " & "Grade " & Range("S1").Value & Range("T1").Value _ & " " خليتين يعتمد عليها التسمية Grade 12A Grade 12B هكذا & Format(Now, "mm-dd-yyyy hh mm' ss'' AM/PM"), تنسيق التاريخ والزمن Quality _ :=xlQualityStandard, جودة الطباعة IncludeDocProperties:=True, خصائص الملف IgnorePrintAreas:=False _ , منطفة الطباعة OpenAfterPublish:=True فتح الملف بعد حفظه في صورة بي دي اف Book1.rar

السلام عليمن ورحمة الله وبركاته الكود التالي لحفظ الورقة النشطة على صورة بي دي اف مع تسمية تعتمد على خليتين في نفس الورقة مع تاريخ اليوم والزمن والحفظ في نفس مكان الملف الاصلي ارجو ان ينال اعحابكم Sub SaveAsPDF() Application.ScreenUpdating = False ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ ThisWorkbook.Path & "\" & ActiveSheet.Name & " " & "Grade " & Range("S1").Value & Range("T1").Value _ & " " & Format(Now, "mm-dd-yyyy hh mm' ss'' AM/PM"), Quality _ :=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False _ , OpenAfterPublish:=True Application.ScreenUpdating = True End Sub

استخدم التالي Private Sub a_AfterUpdate() Me.b = Format(Me.a, "dddd") End Sub

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

السلام عليكم ورحمة الله وبركاته شكرا جزيلا استاذنا الفاضل جعله الله في ميزان حسناتك طلب اخير اريد معرفة مكونات النطاق الديناميكي دلالة كل جزء =OFFSET(AliElmasry2!$L$7;;8;COUNTA(AliElmasry2!$L$7:$L$17)) أي =OFFSET(AliElmasry2!$L$7 ; ; 8 ; COUNTA(AliElmasry2!$L$7:$L$17))

تم التعديل اضافة عدة مرفقات وفتح مرفق .rar

جزاك الله خبرا

اضف تنسيق شرطي باستخدام معادلة واكتب ما يلي واجعل لون الخط ابيض =IF(TRIM($C$14)="ناجح";TRUE;FALSE) تم استخدام دالة Trim لحذف اي مسافة زيادة لانك استخدمت دالة concatenate مع وضع مسافة بين كل كلمة واخرى ====================== او في rasd2 اكتب الدالة كما يلي =trim(CONCATENATE(DZ10;" ";EA10;" ";EB10;" ";EC10;" ";ED10;" ";EE10;" ";EF10;" ";EG10;" ";EH10;" ";EI10;" ";EJ10;" ";EK10)) وفي التنسيق الشرطي استخدم التالي =IF($C$14="ناجح";TRUE;FALSE) او دون استخدام تنسيق شرطي اكتب الدالة في الخلية P14 كما يلي =IF(C14="";"ناجح";Main!$C$11) بشرط اكتب الدالة كما يلي =trim(CONCATENATE(DZ10;" ";EA10;" ";EB10;" ";EC10;" ";ED10;" ";EE10;" ";EF10;" ";EG10;" ";EH10;" ";EI10;" ";EJ10;" ";EK10)) شيت ابتدائي.rar

السلام عليكم ورحمة الله وبركاته لدي جدول في بعض الاحيان يكون الصفين الاخيرين فارغين عند عمل رسم بياني للجدول يظهر الجزء الفارغ في الرسم لا اريد ان يظهر هذه الجزء في المرفق توضيح اكثر لكم مني كل تقدير Dynamic Range.rar

السلام عليكم ورحمة الله وبركاته لدي جدول في بعض الاحيان يكون الصفين الاخيرين فارغين عند عمل رسم بياني للجدول يظهر الجزء الفارغ في الرسم لا اريد ان يظهر هذه الجزء في المرفق توضيح اكثر لكم مني كل تقدير Dynamic Range.rar

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

شكرا جزيلا

MyRange = ActiveSheet.Range("C3") تحدد الخلية التي سوق تغير فيها المقياس او الزووم للصفحة وهنا الخلية C3 ActiveWindow.Zoom = MyRange هذه الدالة التي تعمل عملية الزووم

انا المتاسف على الاستعجال استاذنا الكريم لك مني كل الشكر والتقدير نعم هذا هو المطلوب ولكني اتساءل ما الفرق بين $M41 and $M$41

up

Private Sub Worksheet_SelectionChange(ByVal Target As Range) MyRange = ActiveSheet.Range("C3") ActiveWindow.Zoom = MyRange End Sub لكل شيت على حده

اليكم الملف مع الشكر الجزيل على الاهتمام analysis1718.rar