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

السّلام عليكم و رحمة الله و بركاته تفضّل أخي الغالي " أبو عبد الرّحمن البغدادي " .. ربّما يكون المطلوب فائق إحتراماتي زيادة خانات الفورمة.rar

نعم الحمد لله الذى بنعمته تتم الصالحات أخى الغالى أبا يوسف فرحتى الآن لا تقل عن فرحتك بل تزيد تقبل الله دعائك و لك مثله أخى و حبيبى في الله و أستاذى ياسر بارك الله فيك ... ما أروعك ! وما أروع تلك الأثرة فيك ! لولا فضل من الله و لولا تدخلك ما وصلنا الى هذه النتيجة الرائعة بارك الله فيك و فى أهلك و فى مالك و فى وقتك و و فقك فى خدمة اخواننا فى كل مكان فلك مني كل التحية و التقدير

أخي الكريم أبو يوسف 5050 ..يا ريت 7090 دي تبقا لقبك أفضل ... هنا في المنتدى نحب أن نتعرف على الأعضاء بمسمياتهم وألقابهم الحمد لله أن تم المطلوب على خير .. والفضل لله عزوجل ثم الأخ الحبيب مختار صاحب شرارة الإنطلاق الاولى والأخيرة .. ويرجى مستقبلاً عند طرح موضوع أن يتم تناول نقطة واحدة أو طلب واحد في الموضوع لكي لا يتشتت الأعضاء وكي تجد المساعدة من الأخوة الأعضاء إذ أن الموضوع المتعدد الطلبات ينفر الأعضاء من الموضوع (مجرد نصيحة ..ومجرد رأي شخصي) تقبل تحياتي والشكر موصول لصاحب الهمة العالية أخي وحبيبي في الله مختار ..فله مني كل التحية والتقدير

أخي الكريم أبو راكان جرب الكود التالي في حدث ورقة العمل كليك يمين على اسم ورقة العمل ثم اختر View Code ثم الصق الكود التالي Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.CountLarge > 1 Then Exit Sub If Not Intersect(Target, Range("B1:I15")) Is Nothing Then Application.EnableEvents = False Application.ScreenUpdating = False If Target = 1 Then Range(Cells(Target.Row, "B"), Cells(Target.Row, "I")) = 50 Target = 1 ElseIf Target = 2 Then Range(Cells(Target.Row, "B"), Cells(Target.Row, "I")) = 100 Target = 2 End If Application.ScreenUpdating = True Application.EnableEvents = True End If End Sub عند حفظ المصنف يجب الحفظ بامتداد xlsm للحفاظ على الأكواد التي تم إدراجها لمزيد من التفاصيل يمكنك الإطلاع على موضوع "بداية الطريق لإنقاذ الغريق" لطائر البطريق ياسر خليل تقبل تحياتي

100% صحيح يعجز عن شكركم اخوينا مختار حسين واخونا ياسر خليل واتوجه الى الله بالدعاء لكما بأن الله يسعدكم ويفرج همكم ويرزقكم من واسع فضله

أخى الحبيب خيال تم تلبية طلبك دالة للجمع والتلوين على الرابط http://www.officena.net/ib/topic/65138-%D8%B9%D9%85%D9%84-%D8%AF%D8%A7%D9%84%D8%A9-%D8%AA%D9%82%D9%88%D9%85-%D8%A8%D8%A7%D9%84%D8%AC%D9%85%D8%B9-%D9%88%D8%AA%D9%84%D9%88%D9%8A%D9%86-%D8%A7%D9%84%D8%AE%D9%84%D9%8A%D8%A9-%D8%B9%D9%86%D8%AF-%D8%B1%D9%82%D9%85-%D9%85%D8%B9%D9%8A%D9%86/ أخى الحبيب مصطفى بارك الله فيك حللك جميل بس فيه ملاحظات استخدام نفس التنسيق الشرطى مرة على العمود E ومرة على العمود H فالأحرى تطبيق التنسيق على النطاقين مرة واحدة طالما لهما نفس التنسيق يعنى فى خانة appliese to نضع $H$6:$H$80;$E$6:$E$80= يوجد قيم خاطئة فى نتائج المعادلة بالعمودين E و H لأن فيه قيم نصية فى آخر العمودين لذلك تم اضافة الدالة IFERROR و اضافة تنسيق جديد والتعديلات فى المرفق المقارنة++++++.rar

السلام عليكم ورحمة الله بعد إذن إستاذنا واخونا الفاضل السيد علي العيدروس ملفك لايحتاج مفتاح فريد مثل رقم عميل او رقم سند لعدم التكرار لانة من الواضح سيتم التكرار تم إضافة بعض التعديلات ارتأيتها ضرورية 2- صفحة تحصيلات العملاء صفحة مدفوعات الموردين وهي تقريبا نفس صفحة تحصيلات العملاء صفحة مصاريف الشركة وهي تختلف بعض الش عن سابقاتها 1- تم إضافة عمود بمسمى الحساب لكي يرحل أي صف الي الحساب المطلوب ممكن تستفيد منة مستقبلا بأن اضفت حسابات أخرى اكثر وهنا إسم الحساب يرتكز علي إسم الصفحة (الشيت Sheet ) مهما بلغت ففي حالة وجود ذلك فقط قم بإضافتها أي ( الصفحة / الصفحات ) إلي القائمة المنسدلة وعند إختيارها فسيتم الترحيل الي هذه الصفحة مهما تعددت الصفحات ومهما تكررت سيأخذ الأول بالأول First In First Out . صفحة الخزينة وهي الأهم والتي يتم الترحيل إليها من عدة صفحات : تم بعض الإضافات عليها وتنسيقها إمكانية الاستفادة من تصفية البيانات وإعطاء بيانات او معلومات او حصر التحصيلات او مدفوعات الموردين او حصر المصاريف وتم عمل تنسيق شرطي في العمود D الجهة بحيث إذا كانت قيمة الخلية (تحصيلات العملاء) يتم تلوين كامل الصف باللون الأزرق فاتح وإذا كانت قيمت الخلية (مدفوعات موردين)يتم تلوينها باللون البنكي واما إذا كانت القيمة (مصاريف الشركة) فبالتلوين الأحمر للخلفية والخط بالاصفر. اما بخصوص الإجماليات مثل هذه : بعد عمل التعديلات فلا ادري في ماذا ستحتاج لها .بإمكانك عمل تصفية (فلترة) في ناحية الجهه ثم التاريخ سيعطيك نفس النتيجة إذا كنت ترغب في خلاف ذلك أي التعديلات الزائدة التي ممكن لا تتوافق مع متطلبات عملك او غير ذلك. وضًح وسيتم التعديل حسب الاستطاعة ملاحظـــــة / اخي احمد أبو ريان استميحك عذرا بأن اضع الموضوع في موضوع جديد لكي يستفاد منة كل من احتاجه بالبحث لان المشاركات لا تظهر بالبحث اخوك في الله / أبو الحسن والحسين لاحظت ان هناك صور لم تظهر فقمت بأخذ كامل الموضوع أعلاه مع الصور واسندتة بلمف وورد مرفق الملف ترحيل من عدة شيتات الى شيت واحد.rar

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

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

جميع بيانات الملفات لشهر واحد حسب ملفاتك الحاليه ؟ اضفت في بعض الملفات اشهر وهميه بمعنى بيانات لـ 6 اشهر جرب الكود التالي حط الملفات بنفس فولدر الملف الذي به الكود Sub Ali_Tran_Fil() Dim Pth As String Dim F_il As String Dim S_Nm As String Dim My_Vlu() As Variant Dim Lr, Lrr, R, Dy, Ar, Az, Ar_O, ii, rr, pp, Cr Dim Date_M As Date Dim O_Wp As Workbook Dim ws As Worksheet Dim Sh As Worksheet Dim Mi_A As Worksheet Dim sht As Worksheet Set Mi_A = Sheets(1) De_Sht CStr(Mi_A.Name) Apc_Ali False '-------------------------------------------------------------------- Pth = ThisWorkbook.Path & "\" '' مسار الملفات بنفس مسار الملف الحالي '-------------------------------------------------------------------- F_il = Dir(Pth & "*.xlsx") '' xlsx صيغة ملفات الاكسل التي سيتم جلب بياناتها '-------------------------------------------------------------------- ReDim Preserve My_Vlu(1 To 10000, 1 To 6) '-------------------------------------------------------------------- Do While F_il <> "" If F_il <> ThisWorkbook.Name Then S_Nm = Pth & F_il Set O_Wp = Workbooks.Open(S_Nm) Set ws = O_Wp.Sheets(1) Lr = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row For R = 2 To Lr I = I + 1 My_Vlu(I, 1) = ws.Cells(R, 3) My_Vlu(I, 2) = ws.Cells(R, 1) My_Vlu(I, 3) = ws.Cells(R, 2) My_Vlu(I, 4) = ws.Cells(R, 6) My_Vlu(I, 5) = ws.Cells(R, 7) My_Vlu(I, 6) = Split(F_il, ".")(0) Next R O_Wp.Close False F_il = Dir End If Loop '-------------------------------------------------------------------- Mi_A.Range("A2").Resize(UBound(My_Vlu, 1), UBound(My_Vlu, 2)) = My_Vlu '-------------------------------------------------------------------- Mi_A.Sort.SortFields.Add Key:=Mi_A.Range("D2", Mi_A.Range("D2").End(xlDown)), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With Mi_A.Sort .SetRange Mi_A.Range("A2:F" & Mi_A.Range("A1").End(xlDown).Row) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With '-------------------------------------------------------------------- With CreateObject("scripting.dictionary") For ii = LBound(My_Vlu, 1) To UBound(My_Vlu, 1) If My_Vlu(ii, 1) <> "" Then If IsDate(My_Vlu(ii, 4)) Then Date_M = My_Vlu(ii, 4) Dy = .Item(Month(Date_M)) End If End If Next ii Ar = Split(Join(.Keys, ","), ",") End With '-------------------------------------------------------------------- For rr = LBound(Ar) To UBound(Ar) If IsError(Evaluate("'" & Ar(rr) & "'!A1")) Then Set Sh = ThisWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count)) With Sh .Name = CStr(Ar(rr)) Az = Array("رقم العميل", "العدد", "الصنف", "التاريخ", "السعر", "إسم الملف") With .Range("A1") .Offset(0, 0).Resize(1, UBound(Az) + 1) = Az End With .Columns(1).ColumnWidth = 29.29 .Columns(2).ColumnWidth = 8.43 .Columns(3).ColumnWidth = 15 .Columns(4).ColumnWidth = 16.14 .Columns(5).ColumnWidth = 8.43 .Columns(6).ColumnWidth = 8.43 End With End If Next rr '-------------------------------------------------------------------- Ar_O = Mi_A.Range("A1").CurrentRegion.Value For Each sht In Sheets If Not sht.Index = 1 Then For pp = 1 To UBound(Ar_O, 1) If IsDate(Ar_O(pp, 4)) Then If Trim(Month(Ar_O(pp, 4))) = Trim(sht.Name) Then With sht Lrr = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row .Cells(Lrr, 1) = Ar_O(pp, 1) .Cells(Lrr, 2) = Ar_O(pp, 2) .Cells(Lrr, 3) = Ar_O(pp, 3) .Cells(Lrr, 4) = Ar_O(pp, 4) .Cells(Lrr, 5) = Ar_O(pp, 5) .Cells(Lrr, 6) = Ar_O(pp, 6) End With End If End If Next pp End If Next sht '**** Sh_S '**** '\\\\\\\\ Cr = Split(Mi_A.UsedRange.Address, "$")(4) Mi_A.Range("A2:F" & IIf(Cr = 1, 2, Cr)).ClearContents '//////// Apc_Ali True '************************************ Set O_Wp = Nothing: Set ws = Nothing Set Sh = Nothing: Set Mi_A = Nothing Set sht = Nothing: Erase My_Vlu End Sub Private Sub B_Set(Sh_N()) Dim T_m Dim I, J '---------------------------------- Apc_Ali False For I = LBound(Sh_N) To UBound(Sh_N) For J = I To UBound(Sh_N) If Sh_N(I) > Sh_N(J) Then T_m = Sh_N(I) Sh_N(I) = Sh_N(J) Sh_N(J) = T_m End If Next J Next I Apc_Ali True '---------------------------------- End Sub Private Sub Sh_S() Dim Sht_a As Worksheet Dim My_Sh() Dim I '------------------------------------------ Apc_Ali False ReDim My_Sh(ThisWorkbook.Worksheets.Count) I = LBound(My_Sh) For Each Sht_a In ThisWorkbook.Worksheets My_Sh(I) = Sht_a.Name I = I + 1 Next Sht_a '----------- B_Set My_Sh '----------- For I = LBound(My_Sh) + 1 To UBound(My_Sh) If Sheets(My_Sh(I)).Index <> 1 Then Worksheets(My_Sh(I)).Move After:=Worksheets(ThisWorkbook.Worksheets.Count) End If Next I Apc_Ali True '------------------------------------------ End Sub Public Function De_Sht(ByVal Nm_S As String) Dim Sh_D As Worksheet ''------------------------------------ For Each Sh_D In Worksheets Application.DisplayAlerts = False If Sh_D.Name <> Nm_S Then Sh_D.Delete Application.DisplayAlerts = True Next Sh_D ''------------------------------------ Set Sh_D = Nothing End Function Public Function Apc_Ali(Bll As Boolean) ''------------------------------------ With Application .Calculation = IIf(Bll, -4105, -4135) .ScreenUpdating = Bll .EnableEvents = Not Bll End With ''------------------------------------ End Function والمرفقات الملف وبه الكود new_Ali.rar

واقول المنتدى منور ؟ وشامين ريحة عود وعنبر ! تحياتي الاستاذ القدير ابو احمد

السلام عليكم المرفق الاول الشرح والاخر الملف شرح_5.rar البحث بين تاريخين_A.rar

السّلام عليكم و رحمة الله و بركاته أخي الكريم " محمّد عبد السّلام " لتغيير الشّريط من اليسار إلى اليمين أو العكس ..هما كلمتيْن لا ثالث لهما .. لتسهيل العملية لديك قمت بحذف الجزء الملوّن بالأصفر و وضعت نفس الجزء مع تغيير الكلمتيْن المشار إليهما بالسّهم الأحمر فقط .. هذا ملف مخالف لإتّجاه الملف الأول .. إذن أصبح لديك الاتجاهيْن معًا .. احذف ذلك و ضع هذا .. نفس العمل لو أردت تغيير اتّجاه الملف رقم 2 فائق إحتراماتي

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

اخواني الكرام هذه بعض الاكواد المنفصلة و البسيطة التي قد تهم البعض وخاصة المبتدئين مثلي وارجوا من الاخوة الكرام كل من لديه كود يضيفه وأجر الجميع على الله وتسهيلاً على اخواننا في متابعة الموضوع اردت وضع فهرس بالمشاركات التي تحتوي على الاكواد وهنا الفهرس مقسم على ثلاثة أجزاء يحتوي على هذه المشاركات وهذه الملفات من النوع (Pdf) ............................................................ الجزء الأول من فهرس الأكواد المنفصلة (ملف Pdf) الجزء الأول.rar ............................................................ الجزء الثاني من فهرس الأكواد المنفصلة (ملف Pdf) الجزء الثاني.rar ............................................................ الجزء الثالث من فهرس الأكواد المنفصلة (ملف Pdf) الجزء الثالث.rar ............................................................ و هذه النسخة الاولى من برنامج محفظة الاكواد جمعت فيها جميع اكواد هذه الحلقات من هذا الموضوع المحفظة المفرغة من تصميم الاستاذ الكبير خبور جزاه الله خيرا محفظة اكواد_النسخة1.rar أخوكم محمد يحياوي

السلام عليكم ورحمة الله وبركاته تحية عطره الى جميع اعضاء اوفيسنا هذا هو اول نشر لهذا الموضوع فى اوفيسنا اتمنى ان ينال اعجابكم الرابط http://excelfinancial1.blogspot.com.eg/p/blog-page_53.html

السلام عليكم هكذا بيكون Private Sub Workbook_SheetActivate(ByVal Sh As Object) Ap_A False With Sh.UsedRange .Columns.EntireColumn.AutoFit '' الاعمدة .Rows.EntireRow.AutoFit '' الصفوف .Borders.Color = 1 '' البوردر With .Font .Name = "Times New Roman" '' اسم الخط .Size = 10 '' حجم الخط End With End With Ap_A True End Sub Private Function Ap_A(Bn As Boolean) With Application .Calculation = IIf(Bn, -4105, -4135) .ScreenUpdating = Bn .EnableEvents = Not Bn End With End Function

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

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

بالامكان ذلك في حدث Thisworkbook مباشره عند دخولك الصفحه Private Sub Workbook_SheetActivate(ByVal Sh As Object) Sh.UsedRange.Columns.EntireColumn.AutoFit End Sub

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

السّلام عليكم و رحمة الله و بركاته أخي الكريم " أبو عبد الرّحمن البغدادي " .. يبدو أنَّ قدري مرتبط بقدرك لأنّي غالبًا ما أشارك بمواضيعك .. كان يمكن أن أرسل لك الملف جاهزًا لكن فضّلت أخي الفاضل أن تحاول إنجاز ذلك بنفسك .. لاحظ أخي الكريم في شيت البيانات أنّ عمود صافي الرّاتب هو العمود N وهو العمود رقم 14 .. نذهب الآن إلى محرّر الأكواد .. سنجد أنّ التاكست بوكس الخاصّة بصافي الرّاتب هي التاكست بوكس رقم 10 .. ندخل إلى الأكواد الاآن و نلاحظ .. شاهد الصورة يجب أن تكون التاكست بوكس 10 مرتبطة مع العمود 14 لاحظ السّهم الأحمر و السّهم الأخضر بالصورة رقم 3 .. نجد أنّ التاكست بوكس 10 مرتبطة مع العمود 10 المشار إليه بالسّهم الأخضر .. جرّب تغيير الرقم 10 المشار إليه بالأخضر إلى الرّقم 14 و ستتغيّر النتيجة .. إتّبع نفس المنوال لترتيب أمورك .. و الله المستعان فائق إحتراماتي

سلمت اخي الغالي ابا الحسن والحسين وهذا بعد تعديل الاخطاء مساجد .rar والافضل كما ذكرت سابقا الافضل عمل قوائم منسدلة تحتوي هذه الاختيارات

سلمت يمينك أستاذنا الكريم

You're welcome أهلا بك في المنتدى يا صاحب المشاركة الأولى والكلمة الأولى .. ونرجو ألا تتوقف مشاركاتك عند الكلمة الأولي ..كما يرحى تغيير اسم الظهور للغة العربية (حسام المحاسب) تقبل تحياتي

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

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

مشكور استاذ عبدالرحمن وهذه مشاركة معكم تعديل حقل التعبير بعمود balance في الاستعلام ليصبح : Balance: Nz(DSum("[الوارد]-[الصادر]";"العمليات";"[التسلسل]<=" & [التسلسل] & " and [رقم العميل]=" & [العملاء].[رقم العميل]);0) تحياتي

السلام عليكم - حياكم الله - مبارك عضوية الاحتراف - بارك الله فيكم وزادتكم فضلا وعلماً اشكرك وجزيت خيرا على الحل - تمام

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

السلام عليكم شكرا استاذ مختار عمل رائع وتعديل اروع جزاكم الله خيرا

السلام عليكم ورحمة اله ملف Word كيفية تلوين صف بناء علي قيمة خلية مع ملف إكسل كمثال مصغر اخوكم في الله / أبو الحسن والحسين شرح تلوين الصف بناء علي خلية مع مثال2.rar مع الانتباة : لكي تعطى النتيجة السليمة قم بمراجعة تحرير وصف القاعدة أي الصيغة ادناه ( "مشغول"=5 M$ =) تلقاها بالخطأ ( "مشغول"=1048576 M$ =) قم بتعديلها حسب الموضح بالشكل.

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

اذهب الى الدالة التاليه في الكود Private Function Ch_Month(Mn As String) Dim Mm& Dim Tn$, X$ For Mm = 1 To 12 Tn = MonthName(Mm) If Tn = Trim(Mn) Then Mm = Mm - 1 X = MonthName(Mm) Exit For End If Next If Mm Then Ch_Month = X End Function واستبدلها بهذا التعديل Private Function Ch_Month(Mn As String) Dim Im, Tn, X Dim Ar On Error GoTo 1 Ar = Array("يناير", "فبراير", "مارس", "أبريل", "مايو", "يونيو", "يوليو", "أغسطس", "سبتمبر", "أكتوبر", "نوفمبر", "ديسمبر") For Im = 0 To UBound(Ar) Tn = Ar(Im) If Tn = Trim(Mn) Then Im = Im - 1: X = Ar(Im): Exit For Next Im Ch_Month = X 1 End Function اضن السبب تسمية الاشهر لديك ربما تكون بالفرنسية في الـ VBA

السلام عليكم ورحمة الله اخى الحبيب اليك الحل المكافآت.rar

الله ينور أخى الحبيب / عبد العزيز رائــــــــــــــــــــــــــــع تقبل تحياتى

سلمت يمينك أخى الحبيب / حسام زادك الله من فضلة وعلمه جزاك الله كل خير وربنا يتغمض الفقيد / عماد الحسامى برحمته

استبدل الكود عندك بها الكود وسوف ترى النتيجة Sub زر_1() lh = Cells(Rows.Count, "H").End(3).Row lc = Cells(Rows.Count, "c").End(3).Row Range("H5:H" & lh).Clear Range("c5:c" & lc).SpecialCells(xlCellTypeConstants, 1).Copy Range("H5") End Sub

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

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

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

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

ادعو الله خير و ترجع بخير و سلامة

لعله خيرا باذن الله وترجع بالسلامة

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

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

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

السلام عليكم كل الشكر لصاحب الملف وللفائدة من امكانيات الملف اعيد رفعه اليكم بعد إزالة الحماية عنه لحساب السن اليوم والتاريخ الهجري المقابل وسن التقاعد للمعاش.rar

اخي الكريم السلام عليكم انظر للمرفق وكلمة السر رقم 5 هل هو ماتقصده ________________2__________5.rar