اركان الاسلام

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

عتدى شيت الصقخه الاولى للخامات المقدره والصفحه التانيه للمنصرف الفعلى والصفحه الثالثه لعمل تقرير ومقارنه الغريب انى اول ما اشغل الكود واخلص شغل اول ما اقفل الشيت بيتمسح من على الجهاز نهائى ارجو حل للمشكله دى وده الكود علشان لو ركبته داخل الشيت او ما احفظ هيتمسح وارفقت شيت الاكسيل بنفس ترتيب الصفحات والاعمده والصفوف وبارك الله فيكم جميعا Sub مقارنة_المشاريع() Dim wsArchive As Worksheet, wsIssue As Worksheet, wsReport As Worksheet Dim lastRowArchive As Long, lastRowIssue As Long, lastRowReport As Long Dim i As Long, j As Long, nextRow As Long Dim client As String, itemCode As String, itemName As String Dim materialCode As String, materialName As String Dim dictProjects As Object, key As Variant Dim estimatedQty As Double, estimatedPrice As Double Dim issuedQty As Double, issuedPrice As Double Dim totalEst As Double, totalIss As Double Set wsArchive = ThisWorkbook.Sheets("الارشيف") Set wsIssue = ThisWorkbook.Sheets("اذون الصرف") Set wsReport = ThisWorkbook.Sheets("التقرير النهائى") wsReport.Cells.Clear Set dictProjects = CreateObject("Scripting.Dictionary") lastRowArchive = wsArchive.Cells(wsArchive.Rows.Count, "M").End(xlUp).Row lastRowIssue = wsIssue.Cells(wsIssue.Rows.Count, "A").End(xlUp).Row ' إنشاء قائمة المشاريع من صفحة الارشيف For i = 4 To lastRowArchive client = wsArchive.Cells(i, "M").Value itemCode = wsArchive.Cells(i, "N").Value itemName = wsArchive.Cells(i, "O").Value key = client & "|" & itemCode & "|" & itemName If Not dictProjects.exists(key) Then dictProjects.Add key, key End If Next i ' كتابة الجدول الرئيسي لكل المشاريع wsReport.Range("C5").Value = "اسم العميل" wsReport.Range("D5").Value = "كود الايتم" wsReport.Range("E5").Value = "اسم الايتم" With wsReport.Range("C5:E5") .Font.Bold = True .Interior.Color = RGB(0, 102, 204) .Font.Color = RGB(255, 255, 255) .HorizontalAlignment = xlCenter End With nextRow = 6 For Each key In dictProjects.Keys Dim parts() As String parts = Split(key, "|") wsReport.Cells(nextRow, 3).Value = parts(0) wsReport.Cells(nextRow, 4).Value = parts(1) wsReport.Cells(nextRow, 5).Value = parts(2) nextRow = nextRow + 1 Next key nextRow = nextRow + 2 ' لكل مشروع نكتب جدول تفصيلي For Each key In dictProjects.Keys parts = Split(key, "|") client = parts(0) itemCode = parts(1) itemName = parts(2) ' عناوين الجدول wsReport.Cells(nextRow, 3).Resize(1, 12).Value = Array("اسم العميل", "كود الايتم", "اسم الايتم", "كود الخامه", "اسم الخامه", "كمية مقدرة", "سعر", "إجمالي مقدر", "كمية منصرفة", "سعر منصرف", "إجمالي منصرف") With wsReport.Range(wsReport.Cells(nextRow, 3), wsReport.Cells(nextRow, 14)) .Font.Bold = True .Interior.Color = RGB(204, 255, 255) .HorizontalAlignment = xlCenter End With nextRow = nextRow + 1 ' نبدأ بجمع المواد من صفحة الارشيف For i = 4 To lastRowArchive If wsArchive.Cells(i, "M").Value = client And wsArchive.Cells(i, "N").Value = itemCode Then materialCode = wsArchive.Cells(i, "P").Value materialName = wsArchive.Cells(i, "Q").Value ' التحقق من القيم قبل إضافتها If IsNumeric(wsArchive.Cells(i, "R").Value) Then estimatedQty = wsArchive.Cells(i, "R").Value Else estimatedQty = 0 End If If IsNumeric(wsArchive.Cells(i, "S").Value) Then estimatedPrice = wsArchive.Cells(i, "S").Value Else estimatedPrice = 0 End If ' نبحث في اذون الصرف عن نفس المادة issuedQty = 0 issuedPrice = 0 For j = 2 To lastRowIssue If wsIssue.Cells(j, "B").Value = client And wsIssue.Cells(j, "C").Value = itemCode And wsIssue.Cells(j, "E").Value = materialCode Then If IsNumeric(wsIssue.Cells(j, "G").Value) Then issuedQty = issuedQty + wsIssue.Cells(j, "G").Value End If If IsNumeric(wsIssue.Cells(j, "H").Value) Then issuedPrice = wsIssue.Cells(j, "H").Value ' سعر الكمية المنصرفه End If End If Next j ' نكتب البيانات في الجدول wsReport.Cells(nextRow, 3).Value = client wsReport.Cells(nextRow, 4).Value = itemCode wsReport.Cells(nextRow, 5).Value = itemName wsReport.Cells(nextRow, 6).Value = materialCode wsReport.Cells(nextRow, 7).Value = materialName wsReport.Cells(nextRow, 8).Value = estimatedQty wsReport.Cells(nextRow, 9).Value = estimatedPrice wsReport.Cells(nextRow, 10).Value = estimatedQty * estimatedPrice ' الإجمالي المقدّر wsReport.Cells(nextRow, 11).Value = issuedQty wsReport.Cells(nextRow, 12).Value = issuedPrice wsReport.Cells(nextRow, 13).Value = issuedQty * issuedPrice ' الإجمالي المنصرف nextRow = nextRow + 1 End If Next i ' الآن نبحث عن الخامات المنصرفة التي لم تكن ضمن الخامات المقدرة For i = 2 To lastRowIssue If wsIssue.Cells(i, "B").Value = client And wsIssue.Cells(i, "C").Value = itemCode Then materialCode = wsIssue.Cells(i, "E").Value materialName = wsIssue.Cells(i, "F").Value ' تحقق مما إذا كانت هذه المادة قد تم إضافتها بالفعل ضمن الخامات المقدرة Dim found As Boolean found = False For j = 4 To lastRowArchive If wsArchive.Cells(j, "M").Value = client And wsArchive.Cells(j, "N").Value = itemCode And wsArchive.Cells(j, "P").Value = materialCode Then found = True Exit For End If Next j ' إذا كانت الخامة غير موجودة ضمن المقدرة، نضيفها If Not found Then issuedQty = 0 issuedPrice = 0 If IsNumeric(wsIssue.Cells(i, "G").Value) Then issuedQty = wsIssue.Cells(i, "G").Value End If If IsNumeric(wsIssue.Cells(i, "H").Value) Then issuedPrice = wsIssue.Cells(i, "H").Value End If ' نكتب البيانات في الجدول wsReport.Cells(nextRow, 3).Value = client wsReport.Cells(nextRow, 4).Value = itemCode wsReport.Cells(nextRow, 5).Value = itemName wsReport.Cells(nextRow, 6).Value = materialCode wsReport.Cells(nextRow, 7).Value = materialName wsReport.Cells(nextRow, 8).Value = 0 ' لا يوجد كمية مقدرة wsReport.Cells(nextRow, 9).Value = 0 ' لا يوجد سعر مقدر wsReport.Cells(nextRow, 10).Value = 0 ' إجمالي مقدر = 0 wsReport.Cells(nextRow, 11).Value = issuedQty wsReport.Cells(nextRow, 12).Value = issuedPrice wsReport.Cells(nextRow, 13).Value = issuedQty * issuedPrice ' الإجمالي المنصرف nextRow = nextRow + 1 End If End If Next i ' صفين فاصلين nextRow = nextRow + 2 Next key wsReport.Columns("C:N").AutoFit MsgBox "تم إنشاء التقرير المقارن لكل المشاريع." End Sub New Microsoft Excel Worksheet.xlsx ردإعادة توجيه إضافة تفاعل

بارك الله فيك يا جناب المحترم الكود يعمل بشكل ممتار ليا سؤال هل ممكن اضافه ميزه ارسال الصور

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

ارسال رسائل عبر الواتس اب.xlsx شكرا مقدما ارجو عمل اللازم لاتمكن من ارسال الرسائل من خلال الاكسيل لاكبر عدد ممكن من الاشخاص على الواتس ولكم جزيل الشكر

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

السلام عاليكم اخوتى الاعزاء جزاكم الله جميعا خيرا فلقد استفدت منكم الكثير والكثير ارجو المساعده فى عمل معادله للوارد اولا يصرف اولا الوارد اولا يصرف اولا.xlsx

بارك الله فيك ياخى لقد افاد وفاض ووفى واستكفى حبيبي تسلملى

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

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

جربت اكثر من كود لكنه ينقل فى اماكن متفرقه المطلوب ترحيل البيانات من عمو د f و h من الصفحه الثانيه الى العمود i و l فى الصفحه االثالثه ثم مسح البيانات من الصفحه الثانيه ولقد قمت بتلوين الاعمده لتاكيد من العمود الاخضر فى الصفحه الثانيه الى العمود الاخضر فى الصفحه الثالثه ومن العمود الاحمر فى الصفحه الثانيه الى العمود الاحمر فى الصفحه الثالثه وجزاكم الله خيرا مطلوب النقل.xlsm

اخ سليم بارك الله فيك وشكرا لاهتمامك المطلوب انى هختار اكتر من مره اريد الرقم الى هو بيثمل سعر اليوميه قيمه تثبت ويضاف عاليها القيمه الجديده وهكذا بمعنى انا اخترت يوميه ب100 ثم اخترت يوميه اخرى ب50 يعطينى اجمالى 150 وهكذا

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

up

لايتم حفظ التغيرات فى كثيرا من الاوقات الزناتى للتجاره والتوزيع.xlsm

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

استاذنا الفاضل سليم حاصبيا نرجو منك ان تشرح لنا هذا الكود وهو احدى ابداعاتك لكى نتعلم منك نفعك الله بهذا العلم وجعله من العلم الذى تنتفع به يا اخى Option Explicit Sub Add_sheet() Dim myname As Worksheet Dim P As Worksheet Dim sh_n%, k%, i% Set P = Sheets("اليوميه") sh_n = Application.CountA(P.Range("B:B")) - 1 Dim x%, t%: t = 2 Dim mn$ Application.ScreenUpdating = False ''''''''''''''''''''''''''''''''''''''''' For i = 2 To sh_n On Error Resume Next mn = Sheets(P.Range("b" & i) & "").Name x = Len(mn) If x = 0 Then P.Copy after:=Sheets(Sheets.Count) With ActiveSheet .Name = P.Range("b" & i) .Range("G14") = P.Range("F" & i) .Range("a1").CurrentRegion.Offset(1).ClearContents .Range("A:A").NumberFormat = ("dd- mm-yyy") For k = 2 To sh_n + 1 If P.Range("b" & k) = ActiveSheet.Name Then ActiveSheet.Cells(t, 1).Resize(, 4).Value = _ P.Range("A" & k).Resize(, 4).Value t = t + 1 End If Next End With '========================================= Else Set myname = Sheets(P.Range("b" & i) & "") myname.Range("a1").CurrentRegion.Offset(1).ClearContents For k = 2 To sh_n + 1 If P.Range("b" & k) = myname.Name Then myname.Cells(t, 1).Resize(, 4).Value = _ P.Range("A" & k).Resize(, 4).Value t = t + 1 End If Next '''''''''''''''''''''''''''''''''''' End If mn = "" Err.Number = 0 t = 2 Next i P.Select Application.ScreenUpdating = True End Sub tarhil_by_names.xlsm

ماذا تعنى رساله الخطاء هذه ولما يعلق زر design mode وطريقه الحل لكل صوره من الصوره التى تحمل رساله الخطاء التى قمت برفعها ارجو بالترتيب لكى افهم

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

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

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

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

اخى سليم وضعت الماكرو فى Text Box لكن ما زال يظهر ويختفى سوال : هل من طبيعه text box الا يكون ثابت كاى كائن نعمله انثرت زى مايكون ركبه عفريت هههههه اشكرك اخى ولو امكن ممكن ننفذ طريقه البحث هذه بداله يكون افضل من ال Text Box مدام مش عاوز يثبت

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

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