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

السلام عليكم ورحمة الله وبركاته يسرني ويسعدني أن أقدم لكم هدية متواضعة عبارة عن برنامج محاسبي اسميته ( برنامج الخليل المحاسبي ) سبب تسميته هو بنائي على قاعدة معلمنا الجليل @ابوخليل الذي تعلمت من برامجه تعلم صامت فلذلك يسمح لي أن أطلق اسم البرنامج على اسمه عسى أن يكون هذا العمل خليلاً لنا في الجنة ،،، كما أتقدم بجزيل الشكر لمعلمينا الأفاضل الذي تعلمت منه ولا زلت أتعلم منهم وهم تاج على رأسي المعلم الجليل @jjafferr المعلم الجليل @رمهان المعلم الجليل @أبو إبراهيم الغامدي المعلم الجليل @ابا جودى وجميع منسوبي المنتدى أيضاً لا أنس من اقتبست من بعض برامجه في المنتدى الذي لا أذكر أسماؤهم لكن الله يعلمهم . وأشكر الأخ الغالي الأنيس @عبد اللطيف سلوم الذي يشجعني على المواصلة . والآن تقبولوا هديتي ولا تنسونا والدينا ومعلمنا من صالح دعائكم ،،، ودعاؤكم الخالص بشفاء والدي ،،، أرجو أن اتلقى ملاحظاتكم على البرنامج ،،، اسم المستخدمين : ابوخليل/ صالح كلمة المرور : 123 ولمعرفة كلمة المرور ضع هذه العبارة "O123O" في كلمة المرور بعد اختيار اسم المستخدم وهناك أسرار أخرى اكتشفها بنفسك -------------------------------------------- تحديث الخميس 15 ذو القعدة 1440هـ أبرز التحسينات والتطويرات : إضافة صورة لكل مستخدم . إصلاح بعض الأخطاء البرمجة . تحسينات أخرى .  ستجدون مجلد ImgUsers بجوار البرنامج عند إضافة صورة للمستخدم سيقوم الكود بإضافة صور المستخدمين داخل المجلد كلا باسمه . بالتوفيق الرابط الدائم لبرنامج الخليل المحاسبي "متجدد" والمرفق في المنتدى (قد يكون المرفق اعلاه احدث من المرفق هنا) : __BuySal-20190725T151152Z-v09.zip

تم معالجة الامر بتعديل معادلة التنسيق الى COUNTIF(B$3:B$102,B3)>1= ( لاحظ علامة الـــ $ فقط امام الحرف B الاول والثاني ) و التنسيق في النطاق من الخلية B3 الى الخلية AO102 cond_format.xlsx

وعليكم السلام @ابوآمنة نحن أكثر فرحا وحفاوة بهذه المشاريع التي تثلج الصدر وتشرح الخاطر.. وقد ضمنتها تجارك الخاصة، مع ما افدته من هذا المنتى.. في نظري.. المشروع كبير وأعجب كيف استطعت أن تؤلف بين هذا كله.. لا أشك أنه أخذ منك وقتا ليس بالقصير حتى تمكنت من إخراجه بهذه الصورة.. أتطلع منك في المستقبل القريب أن توافينا بشرح موجز بسيط عن مخطط هذا المشروع وكيفية أدائه، لأنه صعب علي التوفيق بين أغراضه (جداول، استعلامات، نماذج، تقارير..إلخ) لتعددها. تمنياتي لك بالتوفيق

الآن تم تغير الاتي : اللون بالكامل إضافة رسائل تنبيه عند محاولة إضافة موظف أو ترحيل موظف أو تكرار موظف إضافة تقرير عام عن التسكين التجربة توضح اكثر وإليكم الصور إليكم المرفق الجديد واعتقد إن شاء الله النهائي اتمنى الاستفادة للجميع Askan.rar

وعليكم السلام 🙂 شكرا اخي صالح على هذا المجهود ، وشكرا على شعورك النبيل على رد الجميل للمنتدى واعضاءه 🙂 جعفر

جرب هذا الماكرو Option Explicit Sub my_sum() Dim Main_Rg As Range, Cel As Range Dim All_Rows%, i%, s#, t% Set Main_Rg = Range("a3", Range("a2").End(4)).Resize(, 14) All_Rows = Main_Rg.Rows.Count i = 1 Do Until i = All_Rows + 1 For Each Cel In Main_Rg.Rows(i).Cells If Cel.Interior.ColorIndex <> xlNone Then t = t + 1 s = s + IIf(IsNumeric(Cel), Cel, 0) End If Next Cel Cells(i + 2, 17) = t: t = 0 Cells(i + 2, 15) = s: s = 0 i = i + 1 Loop End Sub الملف مرفق matloub.xlsm

شرح طريقة عمل الباركود قارئ الملفات على الاكسل الفيديو رابط الموقع لتحميل Bar Code ادخل الى الموقع للتحميل الصور

السلام عليكم 🙂 أخوي @kha9009lid تستاهل درجة خبير ، واجاباتك كانت تقول انك خبير 🙂 جعفر

اعتذر عن تقديم المساعدة مع شيت مقفل بواسطة كلمة سر لكن يمكن ادراج هذا الكود في موديل مستقل ووضع له زر في كل شيت Option Explicit Sub Select_My_sheet() Dim act_sh As Worksheet: Set act_sh = ActiveSheet Dim goto_sh As Worksheet Dim t% t = act_sh.Index Select Case t Case Sheets.Count Set goto_sh = Sheets(1) Case Else Set goto_sh = Sheets(t + 1) End Select goto_sh.Select End Sub

اين الاعجاب

عزيزي محمد.. ما الذي لم يعجبك في التعديل الأخير؟ وما الذي تريد الوصول إليه؟ الشفرة التي أشرت إليها أعلاه؛ هي التعديل الأخير بالفعل! تم دمجها إلى الشفرة الأولى! .. الاعتماد على الاسم في تسمية الصور يسبب إرباك في المستقبل، لأن الاسماء تتشابه فلماذا لا تعتمد على المعرف؛ فهو أكثر ملائمة واستقرارا من الاسم! .. في صدري فضول لمعرفة لماذا خلت قاعدة البيانات التي أرفتها من جدول تعريف العمال وأكتفيت بجدول وسيط؟! .. أعود فأقول أعلمني بما يجول في خاطرك؟، وما الذي تريد تحقيقه؟ وسوف نناقشه حتى نصل إلى حل مرضي إن شاء الله..

بالنسبة للقسم الاول من السؤال تم معالجة الامر ( الصفحة Salim من هذا الملف) (لا حاجة لادخال كل يوم بيومه من الشهر (يكفي كتابة رقم الشهر والسنة واكسل يقوم بالباقي) بالنسبة للأسئلة الباقية يرجى التوضيح اكثر مع اعطاء أمثلة واقعية Salery.xlsx

ولا تزعل علينا يا أستاذي العزيز لم أنبه عليها من قبل والنظر ليس بالدقيق تفضل تم العديل Askan.rar

وعليكم السلام-اهلا بك في المنتدى فهذه المشاركة ينقصها معطيات-فقد تم بالفعل حساب اجمالى قيمة الشيفت لكل موظف طبقا للشروط التي وضعتها ولكن : كيف يتم حساب قيمة الساعات الإضافى والمتأخرات لكل موظف على الرغم انه ليس هناك أوقات محددة لحضور وانصراف الموظفين فيجب عليها وضع هذه الأوقات في الملف ويمكنك حسابها بنفسك testxl.xlsx

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

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

بارك الله فيك وجزاك الله خير ابا آمنه على المجهود الرائع والمميز الف شكر لك اخي الكريم وفقك الله

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

السلام علكم ورحمة الله وبركاتة بمناسبة العودة الميمونة لاستاذي ومعلمي القدير الاستاذجعفر @jjafferr اقدم لكم هذه الهدية المتواضعه جدا تطبيق نظام الصلاحيات على ازرار التحكم نظام صلاحيات المستخدمين يقوم بالتحكم في صلاحيات المستخدم من حيث الاضافة والتعديل والحذف لكن عند تنفيذ احد هذه الاوامر عن طريق زر تحكم فأنه يتم تنفيذه دون الرجوع او الاتصال بالوحدات النمطية الخاصة بتطبيق نظام الصلاحيات لذا رأيت عمل هذاتعديل غلى نظام صلاحيات المستخدمين الذي قام بعمله الاستاذ مهند عبادي اذا لم تخذلني الذاكرة وقام بتطويره عدد من الاساتذة نسحه بعد نسخه قمت باضافة بعض الاكواد على ازرار التحكم والتي يمكن من خلالها تطبيق نظام الصلاحيات للمستخدمين على ازرار التحكم عن طريق الاتصال بالوحدة النمطية قبل تنفيذ الامر للتأكد من وجود صلاحية للاجراء المطلوب تنفيذه مثلا اذا كان المطلوب اضافة سجل عند التركيز على زر الامر يتم الاتصال بالوحدة النمطية للتأكد هل المستخدم لديه صلاحية اضافة سجلات اذا كان نعم يتم تنفيذ الامر واذا كان لا فيتم اظهار رسالة تفيده بأنه ليست لديه صلاحية لهذا الاجراء يوجد ايضا بالامثال بعض الاكواد لتأمين و الغاء تأمين الحقول دفعة واحدة اترككم مع المثال اترككم مع المثال اسم المستخدم لمسؤول النظام : 1 الباسورد:1 اسم المستخدم: 100 الباسورد: 100 Usrse.rar

لا أخفيك أخي الغالي عبداللطيف تعلمت منك معنى الهدية كل مرة نرى هداياك مبثوثة كالورد . تعلمت منك معنى( حب لأخيك ما تحبه لنفسك )

يا اخي هذه سهلة ، بس مو بالالوان ، وانما بالمجموعات 🙂 اختار . . خليك ماسك زر Ctrl واختار الكائنات اللي تريدها للمخصص . واختار مجموعة جديدة . واكتب الاسم اللي تريد . جعفر

أبشرك الأمور طيبة أخونا الطيب/ عبداللطيف لدي ظرف طارئ ، توقفت قليلاً سأواصل - بشيئة الله تعالى - وشكراً لاهتمامك ومتابعتك ،،

او 🙂 جعفر

السلام عليكم و رحمة الله و بركاته اليك المثال ب اضافة تنقل بين عناصر القائمة ب ازرار الاسهم test.accdb من اجل تحديث مصدر الصف الكومبو ، مع كتابة كل الحرف ينتقل التركيز الى Txt ثم تحدث مصدر صف القائمة ثم ينتقل الي القائمة مرة اخرى و هكذا لان لايمكن تحديث مصدر الصف و داخله تركيز بتوفيق،،،

القصه مش فى طريقه .. اي حد فى المجال بيجتهد وبيحاول .. جايز يفلح ربنا يحلهالك .. بس انا قصدي ان محدش هيعرف يشتغل او يقيم الا لو شاف اختار حد تثق فيه .. وابعتله الملف .. ده قصدي ..

أما الملاحظة الأولى فلا ادري لو أردت ان أضيف سرير بالمستقبل هل يضيف الكود أو لا يبقى على ما أضفت سابقا جرب واخبرني . فانا جعلت الأمر يدوي أسهل من بداية إضافة الطوابق إلى إضافة الغرف واعتقد لا يوجد في البرنامج الأول إضافة طوابق لم يمر علي هذا الأمر في البرنامج الأول لأن الأستاذ أبو خليل ترك الأمر لك لتنفيذ هذا الشيء وجهزت الأمر للجميع لمن أراد ان يستخدم البرنامج من الإضافة سواء طوابق او موظفين أو غرف أو أسرة ثم أسناد ما أضاف وإن أرد فليحذف سرير لم يعد موجود بالغرفة أم الملاحظة الثانية فتاريخ الدخول والخروج واضح من تقرير عن موظف سواء بالاستعراض عن طريق الفورم أو التقرير كما هو بالصور التالية أم الملاحظة الأخيرة فأتمنى أن أكون قد وضعت لها حلا في البرنامج المرفق أرجو التجربة وأبداء الملاحظات والله ولي التوفيق أسأل الله لي ولكم التوفيق والسداد والمغفرة وجنة عرضها السموات والأرض Askan.rar

برنامج التقسيط.rar اخواني اعتذر لعدم وجود وقت لرفع نسخة من الملف تقبلو التحية رجب فاروق

سيتم العمل على الملاحظات بإذن الله واعتذر عن التأخر فلست بالقرب من المنزل مسألة التقرير لا يعرض بيانات لأنك لم تسكن الأخ جعفر

اتفضل أخى الكريم ضع الكود التالى فى حدث الفورم سيظهر لك التكست بوكس 1 يحتوى على الوقت تلقائيا الكود Private Sub UserForm_Activate() Me.TextBox1 = Format(Date, "h:mm AM/PM;@") End Sub

اتفضل أخى الكريم تعديل بسيط على الكود الموجود بالملف يوضع فى حدث الضغط على الزر الموجود بالفورم سيقوم بفتح الملف الآخر Backup data الموجود بنفس المجلد الموجود به الملف الأول ( شرط اساسى ) وسيقوم بترحيل البيانات ثم حفظه وإغلاقه الكود Dim sh As Worksheet, ws As Worksheet Dim wkb As Workbook If TextBox1.Value = "" Or TextBox2.Value = "" Or ListBox1.Value = "" Or ListBox2.Value = "" Or ListBox3.Value = "" Or ListBox4.Value = "" Or ListBox5.Value = "" Then MsgBox "برجاء اكمال البيانات" Exit Sub End If '========================================================= Set wkb = Workbooks.Open(ThisWorkbook.Path & "\Backup data.xls") Set ws = Sheets("TAG CALL") ws.Activate '======================================================== LROW = Range("A" & Rows.Count).End(xlUp).Row Range("A" & LROW + 1).Value = TextBox2.Value Range("A" & LROW + 1).Offset(0, 1).Value = ListBox2.Value Range("A" & LROW + 1).Offset(0, 2).Value = ListBox4.Value Range("A" & LROW + 1).Offset(0, 3).Value = ListBox3.Value Range("A" & LROW + 1).Offset(0, 4).Value = ListBox5.Value Range("A" & LROW + 1).Offset(0, 5).Value = ListBox1.Value Range("A" & LROW + 1).Offset(0, 6).Value = TextBox1.Value TextBox1.Value = "" TextBox2.Value = "" ListBox1.Text = "" ListBox2.Text = "" ListBox3.Text = "" ListBox4.Text = "" ListBox5.Text = "" '--------------------------------- wkb.Close SaveChanges:=True

للتسلية فقط في الملف رقمان متساويان لكن عندما نسأل البرنامج هل هما متساويان بواسطة "=" يعطينا الجواب False لمن يرغب تفسير ذلك الخلايا محمية ريثما احد من الأعضاء يجد الحل الباسوورد والاجابة فيما بعد من الغاز اكسل .xlsx

بارك الله فيك استاذى الكريم وذلك لأن منازل الرقم العشرى فى الخلية B2 أكبر من منازل الرقم العشرى فى الخلية B3

الكابتال او الأسمول مجرد كتابة من لوحة المفاتيح لا تفرق أما بالنسبة للمتغيرات M -S-N فتعبر عن أول سطر يتم الترحيل له

M = 6: N = 6: S = 6 Range("A" & R).Range("a1:cx1").Copy With Sheets("ناجح") .Range("a" & M).PasteSpecial xlPasteValues .Range("a" & M).PasteSpecial xlPasteFormats .Range("a" & M) = M - 6 انا معجب بحلولك جزاك الله خيرا وبعد من فضلك ماذا تعني أحرف A - a - N - S --M الكابتل والاسمول

جرب الملف التالى abo_abary_الشيت.rar

هذا هو المرفق الشيت.rar الذي نريد تطبيق الكود عليه

Sub ناجحين() Dim c As Range For Each c In Sheet1.Range("case") If c.Value = "ناجح" Then Z = Z + 1 lstrow = Sheet2.Range("b20000").End(xlUp).Row + 1 Sheet2.Range(Sheet2.Cells(lstrow, "b"), Sheet2.Cells(lstrow, "ag")) = _ Sheet1.Range(Sheet1.Cells(c.Row, "b"), Sheet1.Cells(c.Row, "ag")).Value Sheet2.Cells(lstrow, "a") = Z: End If Next c End Sub المحترم استاذ ابو عبد الباري لو تكرمت نريد شرحه

من فضلك ارسال الشيت الخاص بك للعمل علية

السلام عليكم ورحمة الله وبركاته بعد اذن اخى الحبيب سليم حاصبيا ده حل اخر ... باحد اكواد المنتدى لاخينا العبقرى ... الحسامى ترحيل ناجح ودور ثانى.rar

اليك الحل بواسطة المعادلات توزيع الطلاب.rar

هل تريد المطلوب مثل هذا توزيع طلبة.rar

أخى الحبيب " محمد " أسف على التأخير لإنى أعتقدت إن المشكلة قد حلت فى أخر مشاركة بيننا وأيضا المعادلة تعمل بكفاءة ممتازة ولكن هناك رابط فى النطاق المعرف " TBL " هو إللى مسبب هذه الإشكالية وبمجرد حذفة وإعادة تحديد النطاق مرة أخرى تعود المعادلة للعمل بشكل طبيعى استدعاء بشرطين33.rar

السلام عليكم ورحمة الله أخي الكريم إسلام، جرب المرفق بالأسفل وأعرف أنه ما زالت بعض التعديلات (وعلى الخصوص الحالة التي نختار فيها خلية تحوي قبلا بعض الحروف -في حالتنا يجب مسحها وإعادة كتابتها من جديد)... أخوك بن علية ملاحظات : - عند كتابة بعض الحروف من اسم العميل يجب التأكيد بزر ENTER ثم الاختيار من القائمة المنسدلة في الخلية. - لا يمكن اختيار عدة قيم للفلترة مثل : حم / سل / ب (كل مرة اختيار واحد). - القوائم المنسدلة تعمل بالشرطين (اسم المكتب واسم العميل)... المرفق : فلترالقائمة المنسدله112.rar

ايه الغزل ده اخجلتم تواضعنا

السلام عليكم BOOK_1.rar

السلام عليكم هذا تعديل طفيف على الكود لتحصل على التجميع في كود التقرير Sub BB() Dim i As Long, ii As Long On Error Resume Next Range("c7:g55").ClearContents Set MySheet = Sheets("data") For i = 1 To 7 If i > 1 Then Range("C" & [d10000].End(xlUp).Row + 1) = "الأجمالي" Range("C" & [d10000].End(xlUp).Row + 2) = MySheet.Cells(7, i + 11) Range(MySheet.Cells(8, i + 11), MySheet.Cells(MySheet.Cells(Rows.Count, i + 11).End(xlUp).Row, i + 11)).Copy Range("d" & [d10000].End(xlUp).Row + 2 + T).PasteSpecial (xlPasteValuesAndNumberFormats) T = 1 Next Application.CutCopyMode = False For i = 7 To 55 '''''''''''''''''''' If CStr(Cells(i, "C")) = "الأجمالي" Then Cells(i, "e").Resize(1, 3).Formula = "=SUM(R[-" & ii - 1 & "]C:R[-1]C)" ii = 0 Else ii = ii + 1 End If '''''''''''''''''''' If Cells(i, "d") >= 1 Then Cells(i, "e") = Application.WorksheetFunction.SumIf(Sheets("saad").Range("b7:b5000"), Cells(i, "d"), Sheets("saad").Range("c7:c5000")) Cells(i, "f") = Application.WorksheetFunction.VLookup(Sheets("report2").Range("d" & i), Sheets("data").Range("d6:e100"), 2, 0) Cells(i, "g") = Val(Cells(i, "e")) * Val(Cells(i, "f")) End If Next With Sheets("report2").[b6:g55] .Font.NAME = "Arabic Typesetting" .Font.Size = 14 .Font.Bold = True End With End Sub في امان الله

السلام عليكم جرب هذا Sub KH_START() Dim Last1 As Long, Last2 As Long With ورقة2 Last1 = .Range("A" & .Rows.Count).End(xlUp).Row For R = 11 To Last1 If Val(.Cells(R, "C")) + Val(.Cells(R, "D")) Then Last2 = ورقة1.Range("A" & .Rows.Count).End(xlUp).Row + 1 ورقة1.Cells(Last2, "A").Value = .Cells(R, "B").Value ورقة1.Cells(Last2, "B").Value = .Cells(R, "A").Value End If Next End With End Sub او هذا Sub KH_START() Dim Last1 As Long, Last2 As Long With ورقة2 Last1 = .Range("A" & .Rows.Count).End(xlUp).Row For R = 11 To Last1 If Val(.Cells(R, "C")) + Val(.Cells(R, "D")) Then Last2 = ورقة1.Range("A" & .Rows.Count).End(xlUp).Row + 1 ورقة1.Cells(Last2, "A").Value = .Cells(R, "B").Value ورقة1.Cells(Last2, "B").Value = .Cells(R, "A").Value ورقة1.Cells(Last2, "C").Resize(1, 2).Value = .Cells(R, "C").Resize(1, 2).Value ورقة1.Cells(Last2, "E").Value = Val(.Cells(R, "C")) - Val(.Cells(R, "D")) End If Next End With End Sub تحياتي

لا أحد يفر من صائد الخبراء..😎 مبارك عليك الشارة أستاذ خالد أرجو من جميع الزملاء الانتباه على إجاباتهم حتى لا يقعوا في المصيدة..😉