مداد_1423

ألف مبروك وإلى الأمام

نفع الله بعلمكم وزادكم علماً ورزقكم الصحة ووسع لكم في رزقكم

تحياتي

الجدول معمول بالوورد وليس إكسل

حولته لك على الوورد

بكل سهولة تستطيع النسخ من الوورد إلى الإكسل لو تحب

لكن .. لاحظ بعض الخلايا النص طويل جدا أنسب تكون في الوورد

تحياتي

BOQ.docx

المعادلة شغالة 100% 

اضغط من لوحة المفاتيح CRTL+` يعني كنترول مع حرف الذال بالعربي

واسحب المعادلة إلى آخر صف

جزاك الله خيرا يا أستاذنا (محمد صالح)

كفيت ووفيت بارك الله فيك وزادك علما ومتعك بصحتك وعافيتك ورزقك من حيث لا تحتسب

قال الرسول صلى الله عليه وسلم (خير الناس أنفعهم للناس)ـ

تحية طيبة للجميع وأسأل الله أن يديم عليكم لباس الصحة والعافية

عندي كودين الأول لترحيل حلقة متكررة إلى شيت 2 وحفظ الشيت الثاني PDF

والكود الثاني من تعديل الأستاذ (الرائد77)

عند دمج الكودين يطلع لي خطأ في السطر sned

بمعنى أن الترحيل إلى PDF يعمل تمام ولكن المشكلة ما قدرت أرسله على الإيميل الخطأ عند send

المطلوب :

1) تصحيح خطأ الإرسال بالإيميل

2) وإذا كان من الممكن استبدال سطر

    a = 1
    
    Do While a <= 4

بهذا السطر لكي استغني عن تعديل الكود في كل مرة 

For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row

الكود بالكامل

Sub Send_Payslip()

  Dim OutApp    As Object
  Dim OutMail   As Object
    
    a = 1
    
    Do While a <= 4
    
    EmpID = Sheet2.Range("A8").Offset(a, 0).Value
    Sheet3.Range("A8").Value = EmpID
    
    Filename = Sheet3.Range("A1").Value & ".pdf"
    Sheet3.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & Filename
    
      Set OutApp = CreateObject("Outlook.Application")
  Set OutMail = OutApp.CreateItem(0)
  With OutMail
    .To = Range("A22").Value
    .Subject = Range("A1").Value
    .HTMLBody = Range("A1").Value
    .Attachments.Add (ThisWorkbook.Path & "\" & Sheet3.Range("A1").Value & ".pdf")
    .Send
  End With
  Set OutMail = Nothing
  Set OutApp = Nothing
    
        a = a + 1
        
        Loop

End Sub

تحياتي للجميع

إرسال إيملات pDF.xlsm

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

الأفضل لك أن تستخدم دالة INDEX مع MATCH وستترك استخدام دالة VLOOKUP

ستجد في اليوتيوب شروحات كثير لها وبها تستطيع أن تبحث بنص أو رقم ولا يشترط أن يكون المرجع في أول الصف

مرنة جدا ... أنصحك وبشدة

وإذا مصمم على الـVLOOKUP

أرفق الملف والأساتذة ما يقصرون

تحياتي

شكرا للأساتذة على سرعة الرد

الله يفرج همك ويفرحك بما تحب ، ويرزقك من واسع فضله ويمتعك بصحتك

كنت أتوقع المشكلة أكبر من ذلك ، شكرا لك انحلت المشكلة وهذا هو المطلوب

سلمت وسلم غاليك وبارك الله فيك

تحية طيبة للجميع 

جربت هذه المعادلة 

=CONCATENATE(A1;CHAR(10);B1;CHAR(10);C1;CHAR(10);+D1)

وما ضبطت

أتمنى أجد الحل عند أحد الأساتذة

مع العلم أني جربت المعادلة نفسها على جهازين عربي وإنجليزي

WINDOWS10

وجربتها على أوفيس 2016 و 365

تحياتي 

New line.xlsx

ما شاء الله .. الصعب عندك سهل .. الله يزيدك علم ويوفقك .. تعودنا منك على الإبداع

عزيزي ... لو يكون الرينج في العامود K أوسع بيكون أفضل وأنفع للسائل ... ولغيره من اللي أعجبهم الكود وينفعهم <<مثلي

تحياتي 

للرفع

تحية طيبة يا سادة ، وأدعوا الله بالتوفيق أن يديم عليكم لباس الصحة 

وبعد:-

Sub LoopThroughFiles()
 
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim i As Integer

    Range("A:A").ClearContents
    
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("D:\TEST_2\FILES")
For Each oFile In oFolder.Files
    Cells(i + 1, 1) = oFile.Name
    i = i + 1
Next oFile

End Sub

أريد أن يكون المجلد الداخلي فقط ثابت FILES

أما المسار الذي قبله متغير كل أسبوع تقريبا

فا ليت أحد يتكرم بتعديل الكود ليكون المسار في الكود نفس مسار الملف مع المجلد  الداخلي FILES

بعبارة أخرى : يكون المسار متغير ، والملف الذي فيه الكود مع مجلد FILES ثابت

مثال:

Set oFolder = oFSO.GetFolder("\FILES")

تحياتي

TEST_2.rar

يقول الرسول صلى الله عليه وسلم: (كان الله في عون العبد ما كان العبد في عون أخيه)ـ

أسأل الله أن يجزيك خير الجزاء ويسعدك في الدرين ويرزقك من حيث لا تحتسب

ولك مني الدعاء والشكر أستاذي

بالله الله فيك وكثر من أمثالك ونفع بعلمك

تحياتي

أستاذي ... بعد الرجوع إلى العمل وتجربة الكود يرسل الإيميل الأول في صف رقم 3

وبعدين تظهر رسالة الخطأ ..

آسف على هذا الشيء ما كان ودي آخذ من وقتكم أكثر ولكن ما قدرت أحل المشكلة وإن شاء الله تكون بسيطة عليكم

أستاذ: الرائد77

بارك الله في عمرك وصحتك ورزقك من حيث لا تحتسب

كثر الله من أمثالك ونفع بك 

هنيئا لك زكاة العلم 

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

تحياتي يا كبير

تحية طيبة للجميع وأدام الله عليكم لباس الصحة 

وبعد:-

في المرفق كود لإرسال إيميل بالآوتلوك يعمل بكفاءة على الصف 3

أريد حلقة تكرارية لكل صف إلى آخر صف

لأن الملف يحتوي في العادة على عشرة صفوف إلى خمسين صف .

Private Sub Send_Email()
  Dim OutApp    As Object
  Dim OutMail   As Object


  Set OutApp = CreateObject("Outlook.Application")
  Set OutMail = OutApp.CreateItem(0)

  With OutMail
    .to = Range("A3").Value
    .CC = Range("B3").Value
    .Subject = Range("C3").Value
    .HTMLBody = Range("D3").Value
    .Send
  End With

  On Error GoTo 0
  Set OutMail = Nothing
  Set OutApp = Nothing
End Sub

إيميللات.xlsm

أسعدك الله أستاذنا علي .. وبارك في عمرك وفي صحتك وعافيتك

وأسأل الله أن يجزيك خير الجزاء

ما نقدر نرد فضلك علينا أستاذ علي إلا بالدعاء ، ولك مني الشكر وخالص الدعاء

تحياتي يا كبير

تحية طيبة وكل عام وأنتم ومن تحبون بخير:ـ

أعاده الله على الجميع في أحسن حال

في المرفقات ملف من شيتين 

فيه إجازات بتواريخ مختلفة .. أريد تقرير في الشيت الثاني بما في الصورة التوضيحية

AnnualVacation.xlsx

(يرفع الله الذين آمنوا منكم والذين أوتوا العلم درجات) ـ

هذا هو المطلوب بارك الله فيك ومتعك بصحتك وعافيتك وجعلك من المقبولين والمغفور لهم
هنيئا لك يا أستاذنا علي زكاة العلم 

ـ جزاك الله خيرا ـ

لك مني الشكر والدعاء 

تحياتي

تقبل الله طاعتكم ، ووفق الجميع لبلوغ ليلة القدر وجعلنا جميعا من المقبولين

وبعد:-

في المرفق ملف من شيتين ، إريد إذا اخترت القسم من القائمة المنسدلة يحضر بيانات جميع الموظفين في نفس القسم

وشكرا لكم جميعا

Data_HR.xls

رائع أستاذي ابو علي و سدرة

المعذرة .. ما لاحظت التغيير في البداية 

فكرة رائعة جدا ما خطرت على بالي

أشكرك من الأعماق

بارك الله فيك ونفعك بك ورزقك من حيث لا تحتسب أنت وكل من مر من هنا

وأخص بالذكر من حاول مساعدتي 

تحياتي 

شكرا لك أستاذي FoMaNsHeE : المعادلة رائعة إذا كان الشهر 31 أو 30 لكن إذا كان 28 أو 29 فتظهر المشكلة

عموما : استفدت من المعادلة وإن شاء الله أحاول بفكرتك أضيف شرط الأقل من 30.

تحياتي

أستاذي الرائد: 

تحياتي لك وشكرا لحرصك على الإفادة دائما .

لكن هذا الحاصل في كثير من الشركات 

يكون الشهر 30 يوماً وحساب الحضور والغياب لا يتعدى الـ 30 يوماً

تحياتي لك

هلا بك أستاذ أبو علي و سدره 

يبدو لي أن فكرتك هي الصح ....تحياتي 

تحية طيبة للجميع

الراتب في شركة على الشهر (30) يوماً ، سواء كان الشهر 31 أو 28 

والحراسات الأمنية رواتبهم 4500 

غياب اليوم الواحد 150 ريال

لكن حصل عندي هذا الشهر مشكلة ما قدرت أحلها

موظف حضر فقط ثلاثة أيام 

صار الغياب عنده 28 يوماً ، فما نزل له راتب إلا يومين ، والصواب ينزل له راتب ثلاثة أيام

الرجاء المساعدة في تعديل المعادلة

تحياتي للجميع

معادلة الحضور.xlsx

رائع يا كبير 

الكود مفيد جدا للكثير

بارك الله فيك وكثر من أمثالك

عبقرية من عبقري

عندي اقتراح ممكن يضيف للمستخدمين

لو في قائمة المكررات يكون في ترقيم لعدد التكرار أتوقع بيرتقي بالفائدة من الملف كثيرا

مثلاً

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

=DATE(YEAR(A1);MONTH(A1)+B2;DAY(A1))
=DATE(YEAR(A1);MONTH(A1)+3;DAY(A1))

معادلتين : إما كتابة الرقم المضاف أو تعيين خلية لإضافة الرقم للشهر

المعادلة تؤدي الغرض ويمكن للأساتذة أضافة نستفيد منها

Month+3.xlsx