نجوم المشاركات

وعليكم السلام-بعد اذن طبعا أستاذنا الكبير صلاح -يمكنك استخدام أيضاً هذه المعادلة =DATEDIF($D2,TODAY(),"y")&"Years, " &DATEDIF($D2,TODAY(),"YM")&"Months, "&TODAY()-DATE(YEAR(TODAY()),MONTH(TODAY()),1)&"Days" مسودة1.xlsx

وعليكم السلام ورحمة الله تعالى وبركاته تفضل اخي جرب هدا Private Sub CommandButton1_Click() Dim WS As Worksheet: Set WS = Sheet3 Dim FileName As String, strDirname As String, Patch As String, strDefpath As String strDirname = Me.TextBox1.Text FileName = WS.[B8] strDefpath = Label2.Caption lr = WS.Range("B" & WS.Rows.Count).End(xlUp).Row WS.PageSetup.PrintArea = "A1:D" & lr + 5 On Error Resume Next If FileName = "" Then MsgBox "يرجى اظافة اسم الملف": Exit Sub If Not Right(strDefpath, 1) = "\" Then strDefpath = strDefpath & "\" If Not Right(FileName, 4) = ".Pdf" Then FileName = FileName & ".Pdf" If Dir(strDefpath & strDirname, vbDirectory) = "" Then MkDir strDefpath & strDirname Patch = strDefpath & strDirname & "\" & FileName WS.ExportAsFixedFormat Type:=xlTypePDF, FileName:=Patch End Sub ملف V2.xlsm

هى أصلا الدالة مش موجودة ولكن اذا كتبتها ستقوم بعملها .. على الرغم أنك لم تقم برفع ملف للتوضيح , فعلى سبيل المثال اذا كان هناك تاريخ موجود بالخلية A2 والتاريخ الأخر بالخلية B2 ....فستكون المعادلة كالتالى : DATEDIF(start_date, end_date, unit) =DATEDIF(A2,B2,"Y") السنوات =DATEDIF(A2,B2,"YM") الشهور =DATEDIF(A2,B2,"MD") الأيام Unit Returns "Y" The number of complete years in the period. "M" The number of complete months in the period. "D" The number of days in the period. "MD" The difference between the days in start_date and end_date. The months and years of the dates are ignored. Important: We don't recommend using the "MD" argument, as there are known limitations with it. See the known issues section below. "YM" The difference between the months in start_date and end_date. The days and years of the dates are ignored "YD" The difference between the days of start_date and end_date. The years of the dates are ignored.

وعليكم السلام ورحمة الله وبركاته يمكنك استخدام الكود التالي في VBA لتحويل الأرقام من النص إلى أرقام: Sub ConvertTextToNumber() Dim cell As Range For Each cell In Range("D2:D50000") If IsNumeric(cell.Value) Then cell.Value = CDbl(cell.Value) Else cell.Value = CDbl(Replace(cell.Value, ",", "")) End If Next cell End Sub يقوم هذا الكود بالتحويل التالي: 1. يتحقق مما إذا كانت القيمة رقمية، إذا كانت رقمية فإنه لا يقوم بتغييرها. 2. إذا لم تكن القيمة رقمية، يقوم بإزالة الفواصل الزائدة وتحويل النص إلى رقم.

تم تعديل الكود 2.xls 1.xlsb 3.xlsm

السلام عليكم ورحمة الله وبركاته @محمد هشام. @حسونة حسين أستاذي القدير - أخواتي وأساتذتي المحترمين ملف الأنشطة عندي في أول شيت به (sheet1) .زرار التصدير إلى pdf يعمل ولكن ينسخ الدول الذي في شيت (الانشطة) وليس sheet1 فأرجو التكؤم مشكورين بجعله يصدر الجدول في sheet1 في نفس مجلده كما هو الحال في زار التصدير الى pdf الموجود في شيت الانشطة كما أرجو منكم جعل الجدول الموجود في sheet1 يبقى موجود في شيت الانشطة لان كل ما ازود حاجة في aheet1 لازم ازود نفس الحاجة في الجدول الموجود في شيت الاشطة فهل ممكن جعل الجدول في الانشطة يأخذ كل شيء من sheet1 ومعلش في مشكلة اخر بتقابلتي - لو حبيت ازود صف في النص مثلا لازم اعيد ترتيب الأرقام من هذا الصف الى آخر الجدول .. فهل هناك حل بحيث لما اضيف صف في النص يعيد ترتيب الأرقام تلقائيا ولكم مني جزيل الشكر 2024 final.xlsm

شكرا لك اخي العزيز

تسلم ايديك بجد حل عبقرى

ملف3.xls ملف2.xlsm

تأكد ان يكون لكل مستخدم اسمه محفوظ في الـ cell B8 ، فهذا الاسم سيتم حفظه مع الملف الـ PDF ككود. يجب تغيير السطر التالي: FileName = Dir(FilePath) إلى: FileName = Range("B8").Value هذا الكود سيجعل اسم الملف الـ PDF يأخذ قيمة الـ cell B8 مباشرة كاسم للموظف.

ويمكنك استخدام الكود التالي في VBA للحصول على نفس النتيجة في جميع إصدارات Excel: Function DateDifference(startDate As Date) As String Dim years As Integer Dim months As Integer Dim days As Integer years = DateDiff("yyyy", startDate, Date) months = DateDiff("m", startDate, Date) Mod 12 days = DateDiff("d", startDate, Date) - Int(DateDiff("d", startDate, Date) / 30) * 30 DateDifference = years & " Years, " & months & " Months, " & days & " Days" End Function يمكنك استدعاء هذه الوظيفة في Excel باستخدام الصيغة: =DateDifference($D2) هذا الكود يعمل في جميع إصدارات Excel.

جزيل الشكر و العرفان . لسيادتكم . استاذ / طارق ..

وعليكم السلام ورحمة الله وبركاته يمكنك استخدام الدالة التالية في خلية E2: =DATEDIF(TODAY(),DATE(سنة المعينة, شهر المعين, يوم المعين),"d") حيث تقوم هذه الدالة بحساب عدد الأيام بين تاريخ اليوم وتاريخ المعين الذي تحدده في الصيغة. يمكنك استبدال "سنة المعينة" و"شهر المعين" و"يوم المعين" بالقيم المعينة التي تريدها.

تفضل ..أيوم كده ,,, كان لابد من البداية رفع ملف تجنباً لإهدار الوقت -لك ما طلبت العمل1.xlsx

وعليكم السلام ورحمة الله وبركاته يمكنك استخدام الصيغة التالية في الخلية E2: =IFERROR(IF(AND(C2>0, A2=0, B2="اسم المطلوب"), IF(ROW(C2)=2, C2*D2, OFFSET(D2, -1, 0)*C2), 0), 0) هذه الصيغة ستتحقق من أن قيمة في عمود C أكبر من صفر، وأن قيمة في عمود A تساوي صفر (التاريخ السابق)، وأن قيمة في عمود B تساوي "اسم المطلوب". إذا تم تحقيق هذه الشروط، سيتم ضرب قيمة في عمود C بقيمة في عمود D، وإلا ستكون القيمة صفر. ويمكنك استخدام الكود التالي في VBA لتنفيذ النفس العملية: Sub CalculateValue() Dim lastRow As Integer Dim i As Integer lastRow = Cells(Rows.Count, "A").End(xlUp).Row For i = 2 To lastRow If Cells(i, 3).Value > 0 And Cells(i, 1).Value = 0 And Cells(i, 2).Value = "اسم المطلوب" Then If i = 2 Then Cells(i, 5).Value = Cells(i, 3).Value * Cells(i, 4).Value Else Cells(i, 5).Value = Cells(i - 1, 5).Value * Cells(i, 3).Value End If Else Cells(i, 5).Value = 0 End If Next i End Sub يقوم هذا الكود بتنفيذ العملية المطلوبة في العمود E بناءً على شروط معينة في الأعمدة A، B و C. يمكنك تشغيل هذا الكود في VBA Editor في Excel عن طريق الضغط على Alt + F11 ولصق الكود في نافذة الكود الخاصة بالورقة التي ترغب في تطبيق العملية عليها، ثم تشغيل الكود.

يمكنك استخدام الكود التالي في VBA لحساب الفرق بين تاريخين بالأيام والشهور والسنوات ويمكن استخدامه في جميع إصدارات Excel: Function DateDiffInDays(startDate As Date, endDate As Date) As Integer DateDiffInDays = DateDiff("d", startDate, endDate) End Function Function DateDiffInMonths(startDate As Date, endDate As Date) As Integer DateDiffInMonths = DateDiff("m", startDate, endDate) End Function Function DateDiffInYears(startDate As Date, endDate As Date) As Integer DateDiffInYears = DateDiff("yyyy", startDate, endDate) End Function يمكنك استخدام هذه الدوال في الصيغ الخلية كما يلي: - لحساب الفرق بالأيام بين تاريخي A1 و B1: =DateDiffInDays(A1, B1) - لحساب الفرق بالشهور بين تاريخي A1 و B1: =DateDiffInMonths(A1, B1) - لحساب الفرق بالسنوات بين تاريخي A1 و B1: =DateDiffInYears(A1, B1) أتمنى أن يكون هذا الكود مفيدًا لك.

السلام عليكم ورحمة الله وبركاته المعذرة في تأخري في الرد فقد أصابتني وعكة صحية شديدة والحمد لله وإني أتوجه بالشكر الجزيل لأستاذنا الفاضل AbuuAhmed فقد أعطت النتيجة صحيحة 100% ، وأنا عاجز عن الشكر ويعلم الله أني قد دعوت لك بظهر الغيب وحقيقة جهد جبار ودرجة خبير قليلة في حقك رفع الله قدرك وجزا الله الجميع خير الجزاء والشكر موصول لكم دائما وأبدا

وعليكم السلام ورحمة الله وبركاته يمكنك استخدام الكود التالي في VBA لحفظ ملف PDF داخل الفولدر الذي تم اختياره: Sub SaveAsPDF() Dim FilePath As Variant Dim FileName As String ' اختيار مسار الفولدر FilePath = Application.GetSaveAsFilename(FileFilter:="PDF Files (*.pdf), *.pdf", Title:="Save As PDF") ' التأكد من ان تم اختيار مسار الفولدر وليس الالغاء If FilePath <> False Then ' استخراج اسم الملف من المسار FileName = Dir(FilePath) ' حفظ الورقة الحالية كملف PDF في المسار المحدد ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FilePath, Quality:=xlQualityStandard MsgBox "تم حفظ الملف بنجاح في الفولدر: " & FilePath End If End Sub ``` يقوم هذا الكود بفتح نافذة اختيار مسار الفولدر ويسمح للمستخدم بتحديد مكان حفظ ملف PDF. ثم يقوم بحفظ الورقة الحالية كملف PDF في المسار المحدد. سيتم عرض رسالة تأكيد بعد حفظ الملف بنجاح.

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

الحمد لله والشكر لله أخي الكريم التعديل علي رأس الدالة يعني التعديل علي القيم الافتراضية فقط بمعني وضع كلمة Optional تجعل هذا الجزء أختياري وإذا وضعت له قيمة فتصبح هذه هي القيمة الافتراضية فمثلاً الدالة التي اشرت اليها تطلب 6 معلومات 4 لن تعمل بدونهم و2 اختياري وقد تم وضع قيمتهم الافتراضية إذا استخدمتها بدون المقاطع الاختيارية فتعتمد القيمة الافتراضية مثال إذا قمت بعمل دالة لجمع رقمين function sumTwoNums(num1 as integer,optional num2 as integer = 5) as integer هنا يلزم إدخال قيمة الرقم الأول num1 اما الرقم الثاني num2 فاختياري وفي حالة لم يتم إدخاله يعتبر موجود بقيمته الافتراضية 5 ويمكن وضع قيم اختيارية داخل الدالة بدون تحديد قيمتها الافتراضية function sumTwoNums(num1 as integer,optional num2 as integer ) as integer ولكل طريقة استخدامها كما ان هذه الدالة ليست هي المستخدمة داخل الكود بل هذه لان هذه الدالة تعود بـ True في حالة وجود تطابق او False اما الدالة الأخرى فتعود بقيم التطابق وإذا اردت التعديل فداخل الكود (nssjSmartSearch_byPage) هنا ------------------------------------- فكرتك حلوة وذكية ربنا يوفقك ويبارك فيك

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

الأستاذة / حنان الأخوة الكرام تحية طيبة وبعد ،،، كما فهمت المطلوب هو دالة لتغير مقاس الصورة الدالة المستخدمة هي WIA_ResizeImage وهذه الدالة تقوم بتغير أبعاد الصورة بـ البكسل PIXEL والبكسلز تتغير بثلاث عوامل الطول والعرض والجودة لذا يجب العلم ان عند تحويل المقاس إلي 8.5 سم × 11 سم يجب أن يتم تحديد أيضاً الجودة المطلوبة والصور التالية توضح الأمر والان نأتي الي الأكواد 1- الاكواد المساعدة للتحويل من MM / CM / INCH إلي PIXELS يجب وضعها في بداية مديول جديد Option Explicit Public Enum convertFrom cm mm inch End Enum Public Enum qualityRes q72PPI = 72 q96PPI = 96 q150PPI = 150 q200PPI = 200 q300PPI = 300 End Enum Public Function ConvertToPixels(Value As Double, unit As convertFrom, resolution As qualityRes) As Double Dim inches As Double Dim finalResolution As Double If Value < 0 Then Debug.Print "ConvertToPixels", "Measurement value must be non-negative." ConvertToPixels = 0 Exit Function End If Select Case unit Case convertFrom.cm inches = Value / 2.54 Case convertFrom.mm inches = Value / 25.4 Case convertFrom.inch inches = Value Case Else Debug.Print "ConvertToPixels", "Invalid unit" ConvertToPixels = 0 Exit Function End Select finalResolution = resolution ConvertToPixels = inches * finalResolution End Function كما يمكن استخدام هذا الموقع للتحويل https://www.aspect-ratios.com/pixel-calculator/ كود التجربة Sub test_ChangeImageSize() Dim sourceImgPath As String Dim targetImgPath As String Dim imgWidth As Double Dim imgHight As Double Dim pxlWidth As Long Dim pxlHight As Long Dim keepAspectRatio As Boolean Dim overWrtieTargetFile As Boolean sourceImgPath = "C:\Users\user\Downloads\Compressed\Cropping an Image With Controll Print v.1\Images\4130001.jpg" targetImgPath = "C:\Users\user\Downloads\Compressed\Cropping an Image With Controll Print v.1\Images\4130001_2.jpg" imgWidth = 8.5 imgHight = 11 keepAspectRatio = False overWrtieTargetFile = True pxlWidth = Round(ConvertToPixels(imgWidth, cm, q300PPI), 0) pxlHight = Round(ConvertToPixels(imgHight, cm, q300PPI), 0) If WIA_ResizeImage(sourceImgPath, targetImgPath, pxlWidth, pxlHight, keepAspectRatio, overWrtieTargetFile) Then Debug.Print "Your Image Resized Successfully" Else Debug.Print "Something Went Wrong !" End If End Sub هذا الإختيار للحفاظ علي تناسق ابعاد الصورة وبالطبع انم لم تكن الابعاد المستخدمة متناسقة فستختلف النتيجة لذا تم عمله هكذا حتي تخرج الصورة بالأبعاد المحددة keepAspectRatio = False وهذا الاختيار للكتابة فوق الملف الجديد إذا كان موجود بالفعل overWrtieTargetFile = True بالتوفيق

تفضل استاذ @Zooro1 محاولتي حسب مافهمت (طالع الشرح واليك المرفق ) . ووافني بالرد . DDCountUsersSendLeters-1.rar

وعليكم السلام ورحمة الله تعالى وبركاته المفروض اخي @Alaa Ammar New ورقة الاشطة خاصة بفلترة البيانات بين تاريخين يتم تحديدهم مسبقا في الخلية D2 و F2 بمعنى انت من تحدد البيانات الظاهرة عليها .في حالة الرغبة بجلب جميع البيانات يمكنك فقط تحديد اول واخر تاريخ لديك على Sheet1 يمكنك اظافة الكود التالي في حدث Sheet1 ليتم تحديث التسلسل تلقائيا . Private Sub Worksheet_Change(ByVal Target As Range) Dim sht As Worksheet: Set sht = Sheets("Sheet1") If Target.Column = 1 Then Application.ScreenUpdating = False Application.EnableEvents = False sht.Range("A9:A" & sht.Rows.Count).ClearContents sht.[A9].Value = 1 With sht.Range("A9:A" & sht.Cells(sht.Rows.Count, "C").End(xlUp).Row) .Formula = "=Row() - 8" .Value = .Value End With Application.EnableEvents = True Application.ScreenUpdating = True End If End Sub Dim desWS As Worksheet: Set desWS = Sheets("Sheet1") Dim dest As Worksheet: Set dest = printing Application.ScreenUpdating = False If Sheets("Sheet1").TextBox1.Text = "" Then: MsgBox "يرجى اظافة معيار الفلترة": Exit Sub rng = Application.WorksheetFunction.Subtotal(3, desWS.Range("L9:L10000")) If rng = 0 Then: MsgBox "لا توجد بيانات للحفظ", _ vbInformation, "تم إلغاء الإجراء": Exit Sub dest.Visible = xlSheetVisible Set a = desWS.Range("A7", desWS.Range("A" & desWS.Rows.Count).End(xlUp)) For r = 1 To 12 Set a = Union(a, Intersect(a.EntireRow, a.Columns(r))) Next r Msg = MsgBox("؟" & " " & "PDF " & ":" & " تصدير التقرير بصيغة", vbYesNo, dest.Name) If Msg <> vbYes Then Exit Sub dest.Range("A2:L" & dest.Rows.Count).Clear a.Copy Destination:=dest.Range("A6") dest.Range("a8").Value = 1 With dest.Range("a8:a" & dest.Cells(dest.Rows.Count, "B").End(xlUp).Row) .Formula = "=Row() - 7" .Value = .Value End With 'حفظ PDF Save_As_PDF2 On Error Resume Next desWS.AutoFilter = False Sheets("Sheet1").TextBox1.Text = "" Application.ScreenUpdating = True 2024 final.xlsm

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

اعتقد ان هذه الفترة هي فترة التحضير للامتحانات يقينا هناك عذر

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

أنا تخصصي أكسس أكثر منه اكسل. أضفت 3 وحدات نمطية (موديولات) لـ أبو هادي، من له قدرة في استخدام امكانيات الاكسل في استخدام تقويم أم القرى فليفدنا. هناك شرط يجب أن تنتبه له وهو خصائص خلايا التاريخ يجب أن تكون لتقويم أم القرى وإلا ستتفاجأ بنتائج خاطئة. فرق مدة إيجار بين تاريخين هجري_03.xlsm