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

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

وعليكم السلام ورحمة الله وبركاته جرب هدا Option Explicit Const Salaries As Double = 250000 Sub SplitTables() Dim WS As Worksheet, Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet Dim lastRow As Long, i As Long, Tbl1 As Long, Tbl2 As Long, tbl3 As Long, arr Dim sum1 As Double, sum2 As Double, sum3 As Double, OnRng As Range, CrWS As Variant Dim tmp() As Double, n() As Long, ky() As Boolean, j() As Boolean, k() As Boolean SetApp False Set WS = ThisWorkbook.sheets("Net") TmpWS "تقسيم1": TmpWS "تقسيم2": TmpWS "تقسيم3" Set Sh1 = ThisWorkbook.sheets("تقسيم1") Set Sh2 = ThisWorkbook.sheets("تقسيم2") Set Sh3 = ThisWorkbook.sheets("تقسيم3") CrWS = Array(Sh1, Sh2, Sh3) For Each arr In CrWS arr.Columns("A:H").Clear arr.DisplayRightToLeft = True Next lastRow = WS.Cells(WS.Rows.Count, "A").End(xlUp).Row ReDim tmp(2 To lastRow), n(2 To lastRow), ky(2 To lastRow) ReDim j(2 To lastRow), k(2 To lastRow) For i = 2 To lastRow tmp(i) = WS.Cells(i, "D").Value n(i) = i Next i Set OnRng = WS.[A1:H1] OnRng.Copy Sh1.[A1]: OnRng.Copy Sh2.[A1]: OnRng.Copy Sh3.[A1] Tbl1 = 2: Tbl2 = 2: tbl3 = 2: sum1 = 0: sum2 = 0: sum3 = 0 For i = 2 To lastRow If tmp(i) > Salaries Then WS.Rows(n(i)).Copy Sh3.Rows(tbl3) tbl3 = tbl3 + 1 ky(i) = True sum3 = sum3 + tmp(i) End If Next i If Not WsTotal(tmp, ky, Salaries, j) Then Call WsTotal(tmp, ky, Salaries, j) For i = 2 To lastRow: If j(i) Then ky(i) = True Next i If Not WsTotal(tmp, ky, Salaries, k) Then Call WsTotal(tmp, ky, Salaries, k) For i = 2 To lastRow If j(i) Then WS.Range("A" & n(i) & ":H" & n(i)).Copy Sh1.Range("A" & Tbl1) sum1 = sum1 + tmp(i) Tbl1 = Tbl1 + 1 ElseIf k(i) Then WS.Range("A" & n(i) & ":H" & n(i)).Copy Sh2.Range("A" & Tbl2) sum2 = sum2 + tmp(i) Tbl2 = Tbl2 + 1 ElseIf Not ky(i) Then WS.Range("A" & n(i) & ":H" & n(i)).Copy Sh3.Range("A" & tbl3) sum3 = sum3 + tmp(i) tbl3 = tbl3 + 1 End If Next i AddTotal Sh1, Tbl1, sum1: AddTotal Sh2, Tbl2, sum2: AddTotal Sh3, tbl3, sum3 ColArr CrWS WS.Activate MsgBox "تم تقسيم جدول الرواتب بنجاح", vbInformation SetApp True End Sub Private Sub AddTotal(sht As Worksheet, ling As Long, total As Double) sht.Cells(ling, "C").Value = "الإجمالي" sht.Cells(ling, "D").Value = Format(total, "0.00") With sht.Range(sht.Cells(ling, "C"), sht.Cells(ling, "D")) .Font.Bold = True: .Interior.Color = RGB(220, 230, 241) End With End Sub Private Sub ColArr(sheets As Variant) Dim sht As Variant For Each sht In sheets sht.Columns("A:H").AutoFit Next sht End Sub Private Sub TmpWS(sheetName As String) Dim WS As Worksheet On Error Resume Next Set WS = ThisWorkbook.sheets(sheetName) On Error GoTo 0 If WS Is Nothing Then Set WS = ThisWorkbook.sheets.Add(After:=ThisWorkbook.sheets(ThisWorkbook.sheets.Count)) WS.Name = sheetName End If End Sub حافظة إلكترونية مصارف التجاري052025 V-2.xls

💥 الإداة بواجهتين ( عربي - انجليزي ) والرسائل والردود حسب كل لغة Code Converter x64.zip Code Converter x32.zip طبعاً ، أتمنى ممن يرغب بتجربة الأداة بأول إصدار لها ، أن يزودني بالنتيجة التي قام بها على الكود ، بحيث :- ينشر في رده الكود الأصل ( الذي قام بتجربته ) ، والكود الناتج ( بعد تحويله من الأداة ) لتعم الفائدة ولمعرفة الأخطاء التي قد تحدث ( ولا شك أن الأداة تحتوي أخطاء كثيرة ، ولكن لإجراءاتكم بالإفادة ) . إن كان يملك الكود الصحيح والمنطقي ( الذي يعمل على النواتين ) ، فشاكراً له تزويدنا به للمقارنة . Code Converter x32.zip Code Converter x64.zip

وعليكم السلام ورحمة الله تعالى وبركاته يرجى ملاحظة أنه في دالة SUMIF يجب أن تكون القيم متطابقة تماما بما في ذلك المسافات الزائدة في بداية أو نهاية النص وهذا لا ينطبق على ملفك الحالي حيث توجد بعض القيم في العمود (j) تحتوي على مسافات إضافية E5 عشاء ________ متطابقة E6 أغراض _______ تتضمن مسافة في البداية E7 اخرى _________ تتضمن مسافة في النهاية للتأكد من ذلك يمكنك نسخ القيم من العمود (O) ولصقها في العمود (J) مباشرة وإستخدام المعادلة المقترحة من الأستاد @عبدالله بشير عبدالله وستلاحظ أن النتائج تبدأ بالظهور بشكل صحيح كما يمكنك استخدام الصيغة التالية لتجاوز هذه المشكلة والتأكد من وجود تطابق بعد إزالة المسافات =IF(J13<>"", SUMPRODUCT(($F$5:$F$28)*((TRIM($E$5:$E$28)=TRIM(J13)))), "") حساب011.xlsx

وعليكم السلام ورحمة الله وبركاته كمثال حساب1 =SUMIF($E$5:$E$1000; J5; $F$5:$F$1000) هي معادلة Excel تستخدم دالة SUMIF لجمع القيم بناءً على شرط معين تركيب الدالة SUMIF(range, criteria, [sum_range]) range: النطاق الذي يحتوي على القيم التي سيتم فحصها بناءً على الشرط. criteria: الشرط الذي يجب أن يتحقق لكي تتم عملية الجمع. sum_range: (اختياري) النطاق الذي سيتم جمع القيم منه إذا تحقق الشرط. شرح الدالة $E$5:$E$1000 → هذا هو نطاق الشرط: Excel سيبحث فيه عن القيم التي تساوي قيمة الخلية J5. J5 → هذا هو الشرط: نبحث عن الخلايا في العمود E التي تحتوي على نفس القيمة الموجودة في J5. $F$5:$F$1000 → هذا هو نطاق الجمع: إذا تم العثور على تطابق في العمود E، سيتم جمع القيمة المقابلة له في نفس الصف من العمود F. يوجد يديل اخر لها نفس النتيجة =SUMPRODUCT(($E$5:$E$1000=J5) * $F$5:$F$1000) ملاحظة / النطاق الى الصف 1000 يمكن زيادته او تقليله وجعلته 1000 حسب قولك ان العدد يمكن ان يكون اكثر اتمنى ان تجد ما يفيد في الشرح اعلاه لك كل التقدير والاحترام

وعليكم السلام ورحمة الله وبركاته جزاكم الله خيرًا على كلماتكم الطيبة ومشاعركم النبيلة، التي أعتز بها كثيرًا. لا يسعني إلا أن أبادلكم الدعاء بمثله وأكثر، وأسأل الله أن يديم بيننا المحبة والاحترام، وأن يوفقنا وإياكم لما فيه الخير والصلاح لكم ما طلبتم في انتظار ردكم من خلال تجربتكم للملف طريقة اخرى للبحث معدلة2.xlsb

بعد اذن استاذي @ابوخليل تفضل استاذ @الميزار طلبك حسب مافهمت . لكن انا زودت فولدر بجوار القاعدة (MyBooks) للناتج بعد التصدير . افتح الملف بتحصل كل طالب بورقة منفصلة اليك المرفق . ووافني بالرد . Miraz.rar

طيب يا فؤش انا مش عارف انت فاهم واللا انت بتحلب الاجابه علشان تكون كامله هو مش مقصود انى انزل الاجابة ناقصه بقدر ما هو مقصود ان تقتصر القاعدة على الفكرة المحاسبية فقط اه وشئ تانى علشان نقول عاوزين كل شئ يبقى بنتكلم فى برنامج كبير ما هو نقطه هتجر وراها نقطه تانيه مرتبطه بيها وده مش موضوعنا مبدئيا هو مينفعش ومش منطقى ان نفس المنتج فى فاتورة واحده يتكرر يعنى كل ما تيحب تعمل عملية بيع لنفس المنتج للتجربه فى كل مره تضيف سجل جديد لعمل فاتورة جديده يا فؤش أفندى صحصح وركز كده وانا قلت ملاحظة ان القاعدة تعتمد على شئ واحد فقط ضبط الحسابات بطريقة دقيقه ومرنه للحساب لرصد وجرد المبيعات بشكل صحيح نحلل كلامك ده يا فؤش أفندي تحليل كلامك بخصوص (سيناريو الشراء المتعدد بأسعار مختلفة) الدُفعة الكمية سعر الشراء الكمية المباعة الكمية المتبقية 1 24 10 4 20 2 24 12 10 14 3 24 9 0 24 المتبقي بالمخزون: 20 + 14 + 24 = 58 وحدة بثلاث أسعار مختلفة و أنت تتساءل: لما أبيع بعد كده… أبيع بأي سعر؟ هل أبيع بالسعر الأخير (9)؟ ولا الأعلى (12)؟ ولا (10)؟ هنا نرجع لفكرة "طريقة البيع" أو "طريقة صرف المخزون"، وهي شيء مهم جدًا يعتمد عليه النظام: الطرق المدعومة في جدول اعداد طرق البيع "طريقة صرف المخزون" : الطريقة شرح FIFO بيع من الدفعة الأقدم أولًا (10 جنيه أولًا ثم 12 ثم 9) LIFO بيع من الأحدث أولًا (9 جنيه أولًا ثم 12 ثم 10) HighestPrice بيع من الدُفعة الأعلى سعرًا أولًا LatestPrice بيع من أحدث دفعة (حسب التاريخ) وبالتالي: السعر الذي يظهر في الفاتورة عند إدخال الكمية يعتمد على طريقة البيع المختارة من الإعدادات. ما المشكلة اللي حصلت معاك؟ انت قلت : السعر اللي اتحدد في الفاتورة عند الرجوع ليها كان 109! وأن أنت مش متأكد هل هو متوسط ولا إيه... هنا فيه احتمالين: إما فى جدول الاعدادات لطريقة البيع تم اختيار طريقة البيع LatestPrice → وبالتالي تم اختيار أحدث دفعة (وسعرها ممكن يكون 109). أو فيه خطأ منطقي حصل أثناء إعادة تحميل الفاتورة (مثلاً: إعادة الحساب تم بطريقة مختلفة بعد الحفظ) هراجع الكود تانى اما بالنسبه للنقطه دى انا اعتمد فى عملى على المرونه وعلى الدقه بتقليل الاخطاء بقدر المستطاع يبقى النقطه اللى انت بتقولها غير انها هتزود خطوات الا ان المستخدم او الكاشير او البائع ممكن يغلط ليه انا بقه من الاول ما اسدد كل الثغرات اللى ممكن يحدث من ورائها اخطاء مقصودة او غير مقصودة يا فؤش افندى ولو تركت للبائع التحكم يا فؤش افندى ممكن يبيع مره من ده ومره أخرى من ده على المزاج بقه او بالنيه او بحسن وسوء الظن او حسب الغزاله جاى تهزر حضرتك يا افندم طيب انا قدمت فكرة وتطبيق عملى على اساس محاسبى صحيح وفى حالة رغبه صاحب العمل فى تغيير النظام المحاسبى يتم ذلك بدون التدخل فى تعديل الاكواد وفى النهايه اللى حابب ينفذ اى اقتراحات اخرى يمكنه عمل ذلك ما هو أنا مش هأقول لحد لا تنفذ اقتراحاتك التى تلبى رغباتك بكل بساطه تعتمد فكرتى على اختيار النظام المحاسبى لالية البيع من جدول اعداد خاص بذلك تحديد سعر الشراء وسعر البيع للدفعة وتاريخ وارد هذه الدفعه عند شرائها لعدم تدخل البائع فى كتابة السعر لتلافى اى مشكل محاسبية احتساب الكميات اليا وديناميكا بدون تدخل امكانية حساب الربح والخسارة بسهولة جدا جدا جدا بناء على ما سبق ومن واقع جدول الفواتير او التفاصيل وبناء على ما سبق عمل جرد مفصل لكل منتج حتى مع اختلاف اسعار البيع والشراء وتعدد الدفعات و تواريخ شراء الدفعات المختلفة طيب جرب المرفق ده يا فؤش أفندى ملاحظة أخيره الاستعلامات المستخدمه فى الأكواد هى : qryAvailableBatchesByProduct , qryAvailableByProduct أما بقية الاستعلامات مجرد استعلامات خدميه يمكن استخدامها فى : التقارير او فى عمل الجرد أو فى عمل حساب المبيعات والمشتريات لمعرفة هامش الربح أو الخسارة لم أهتم بموضوع ضبط الاكواد فى حالة التعديل على الفاتورة او المرتجعات أنا لست بصدد تقديم برنامج ولا بصدد تطبيق هذه الأفكار أنا فقط موضوعى هو اتمتتة عمليات البيع وفق التحكم بختيار طريقة البيع من جدول الاعدادات وفق الاصول المحاسبية التاليه وذلك على حسب فهمى المتواضع من البحث على الانترنت فى هذه الجزئية لإانا لست محاسب ولا أعلم شيئا عن المحاسبة ولا التكالبف قد أكون مخطئا أو مصيبا لذلك يرجى التأكد من أهل الإختصاص .. انا نصحتك وأنت براحتك علشان متجيش تزعق لى بعد كده FIFO بيع من الدفعة الأقدم أولًا (10 جنيه أولًا ثم 12 ثم 9) LIFO بيع من الأحدث أولًا (9 جنيه أولًا ثم 12 ثم 10) HighestPrice بيع من الدُفعة الأعلى سعرًا أولًا LatestPrice بيع من أحدث دفعة (حسب التاريخ) أتمتة عمليات البيع بكل الطرق (V 1.2).accdb

وعليكم السلام ورحمة الله تعالى وبركاته Function NumtoTxt(TheNo As Double, MyCur As String, MySubCur As String) As String Dim txtArr1(0 To 9) As String, txtArr2(0 To 9) As String, txtArr3(0 To 9) As String Dim Myno As String, GetNo As String, RdNo As String, My100 As String, I As Integer Dim My10 As String, My1 As String, My11 As String, My12 As String, GetTxt As String Dim MyAnd As String, Mybillion As String, MyMillion As String, MyThou As String Dim MyHun As String, MyFraction As String, ReMark As String If TheNo > 999999999999.999 Then Exit Function If TheNo < 0 Then TheNo = TheNo * -1: ReMark = "يتبقى لكم " Else ReMark = "" If TheNo = 0 Then NumtoTxt = "صفر": Exit Function MyAnd = " و" txtArr1(0) = "": txtArr1(1) = "مائة": txtArr1(2) = "مائتان": txtArr1(3) = "ثلاثمائة": txtArr1(4) = "أربعمائة" txtArr1(5) = "خمسمائة": txtArr1(6) = "ستمائة": txtArr1(7) = "سبعمائة": txtArr1(8) = "ثمانمائة": txtArr1(9) = "تسعمائة" txtArr2(0) = "": txtArr2(1) = "عشر": txtArr2(2) = "عشرون": txtArr2(3) = "ثلاثون": txtArr2(4) = "أربعون" txtArr2(5) = "خمسون": txtArr2(6) = "ستون": txtArr2(7) = "سبعون": txtArr2(8) = "ثمانون": txtArr2(9) = "تسعون" txtArr3(0) = "": txtArr3(1) = "واحد": txtArr3(2) = "اثنان": txtArr3(3) = "ثلاثة": txtArr3(4) = "أربعة" txtArr3(5) = "خمسة": txtArr3(6) = "ستة": txtArr3(7) = "سبعة": txtArr3(8) = "ثمانية": txtArr3(9) = "تسعة" GetNo = Format(TheNo, "000000000000.000") I = 0 Do While I < 15 If I < 12 Then Myno = Mid$(GetNo, I + 1, 3) ElseIf I = 12 Then Myno = Mid$(GetNo, I + 2, 3) End If If Val(Myno) > 0 Then RdNo = Mid$(Myno, 1, 1): My100 = txtArr1(Val(RdNo)) RdNo = Mid$(Myno, 3, 1): My1 = txtArr3(Val(RdNo)) RdNo = Mid$(Myno, 2, 1): My10 = txtArr2(Val(RdNo)) If Mid$(Myno, 2, 2) = "11" Then My11 = "إحدى عشر" If Mid$(Myno, 2, 2) = "12" Then My12 = "اثنا عشر" If Mid$(Myno, 2, 2) = "10" Then My10 = "عشرة" If Val(Mid$(Myno, 1, 1)) > 0 And Val(Mid$(Myno, 2, 2)) > 0 Then My100 = My100 + MyAnd If Val(Mid$(Myno, 3, 1)) > 0 And Val(Mid$(Myno, 2, 1)) > 1 Then My1 = My1 + MyAnd GetTxt = My100 + My1 + My10 If Val(Mid$(Myno, 3, 1)) = 1 And Val(Mid$(Myno, 2, 1)) = 1 Then GetTxt = My100 + My11: If Val(Mid$(Myno, 1, 1)) = 0 Then GetTxt = My11 End If If Val(Mid$(Myno, 3, 1)) = 2 And Val(Mid$(Myno, 2, 1)) = 1 Then GetTxt = My100 + My12: If Val(Mid$(Myno, 1, 1)) = 0 Then GetTxt = My12 End If If I = 0 And GetTxt <> "" Then If Val(Myno) > 10 Then Mybillion = GetTxt + " مليار" Else Mybillion = GetTxt + " مليارات" If Val(Myno) = 1 Then Mybillion = "مليار" If Val(Myno) = 2 Then Mybillion = "ملياران" End If If I = 3 And GetTxt <> "" Then If Val(Myno) > 10 Then MyMillion = GetTxt + " مليون" Else MyMillion = GetTxt + " ملايين" If Val(Myno) = 1 Then MyMillion = "مليون" If Val(Myno) = 2 Then MyMillion = "مليونان" End If If I = 6 And GetTxt <> "" Then If Val(Myno) > 10 Then MyThou = GetTxt + " ألف" Else MyThou = GetTxt + " آلاف" If Val(Mid$(Myno, 3, 1)) = 1 Then MyThou = "ألف" If Val(Mid$(Myno, 3, 1)) = 2 Then MyThou = "ألفان" End If If I = 9 And GetTxt <> "" Then MyHun = GetTxt If I = 12 And GetTxt <> "" Then MyFraction = GetTxt End If I = I + 3 Loop If Mybillion <> "" Then If MyMillion <> "" Or MyThou <> "" Or MyHun <> "" Then Mybillion = Mybillion + MyAnd If MyMillion <> "" Then If MyThou <> "" Or MyHun <> "" Then MyMillion = MyMillion + MyAnd If MyThou <> "" Then If MyHun <> "" Then MyThou = MyThou + MyAnd If MyFraction <> "" Then If Mybillion <> "" Or MyMillion <> "" Or MyThou <> "" Or MyHun <> "" Then NumtoTxt = ReMark & Mybillion & MyMillion & MyThou & MyHun & " " & MyCur & MyAnd & MyFraction & " " & MySubCur Else NumtoTxt = ReMark & MyFraction & " " & MySubCur End If Else NumtoTxt = ReMark & Mybillion & MyMillion & MyThou & MyHun & " " & MyCur End If End Function تعديل المبلغ - فلس V2.xlsm

عند اختيار ملف اكسيل يضهر هاد الخظء هل من برنامج اوفيس او من ملف الذي تم اختياره ؟

السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء ) اليوم جئتكم ببرنامج المنبه الذكي هدية بسيطة لأعضاء منتدانا الغالي وصف البرنامج :- إمكانية تغيير الثيم من داخل الساعة . إمكانية تغيير نغمة رنين المنبه . نغمة تنبيه كل ساعة . دعم للغفوة كما في أجهزة الموبايل . إمكانية تعديل مدة العفوة حسب الحاجة . إمكانية عمل تنبيه متكرر حسب اليوم ، أو التنبيه لأيام محددة . صور من المنبه الذكي :- عند فتح المنبه لأول مرة لوحة التحكم بالإعدادات واجهة المنبه شاشة وقت التنبيه شاشة ضبط المنبه شاشة عرض المنبهات الفعالة والآن مع التحميل بدايةً النسخة 64 ، وقريباً النسخة الثانية بإصدار 32 إن شاء الله :- 64.zip ملاحظة:- تم حفظ البرنامج بصيغة Accde كونه قيد التطوير والتعديل حالياً وعدناكم بإضافة جديدة وهي إضافة حالة الطقس في شاشة المنبه الذكي ، والحمد لله الذي قدرني على توظيف هذه الميزة داخل التطبيق . وكما ذكرت سابقاً الخدمة تحتاج إتصال إنترنت . من الإعدادات > قم باختيار البلد > ثم تطبيق . وسيتم الإتصال بالسيرفر تلقائياً وإدراج درجة الحرارة في شاشة المنبه الرئيسية . ملاحظة :- درجة الحرارة التي يتم عرضها حالياً هي للعواصم العربية فقط ، وسيتم العمل على إدراج معظم المدن في الدول العربية في تحديثات لاحقة . الملف مفتوح المصدر ، وأطلب منكم فقط الدعاء لوالديّ Smart Alarm.zip وباب الحوار مفتوح للمناقشة

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

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

السلام عليكم =========== اربط الكود التالى بزر CommandButton وغير اسم الصفحة كما تشاء Private Sub CommandButton1_Click() Application.ScreenUpdating = False Sheet1.Select End Sub او Private Sub CommandButton3_Click() Sheets(ورقة4").Select End Sub

إخواني طبعاً الشرح منقول كما هو واضح للأمانه اتمنى للجميع المتعة مع شرح البرنامج وتقبلوا خالص تحياتي اخوكم : حسن علي Learn1 Crystal Reports.zip Learn2 Crystal Reports.rar

الجزء الثالث من الدرس السادس lesson6-3.rar

الدرس السادس عبارة عن 3 اجزاء lesson-6-1.rar Lesson-6-2.rar

الدرس الخامس بالمرفقاتمع قاعدة بيانات Tutorial.rar

الدرس الرابع بالمرفقات lesson_4.rar

الدرس الثالث موجود في المرفقات بصيغة pdf lesson_3.rar

السلام عليكم مرفق الطلب في ملف واحد job_order_1 فقط وعليك عمل نسخ منه حسب الحاجة 2،3،.... وهكذا قبل إجراء الماكرو مع قليل من الشرح لاتتردد في أي سؤال فأنا مهندس قديم وهذا الموضوع ليس غريب عليا بالمرة job_order_1.rar