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

هنا الحل الذهبي بأبسط طريقة DateDiff فاشلة JO_IN_OUT.accdb

اخي الاستاذ سعد ادراج الحضور معضلة حقيقية تتعارض مع المنظومة العامة التي عملناها لـــ (كافة الصفوف وخاصة الفصل الثاني ) .. وشرح السبب يطول انا توصلت لحل ولكني غير مقتنع به فالمطلوب تفضلا منك ان نغلق الموضوع ونكتفي بما توصلنا اليه حيث حققنا ما كتب في العنوان وارجوا ان تعمل عنوانا آخر جديدا بالمطلوب .. فقد نجد من الاخوة الخبراء طريقة وحلا نموذجيا افضل من الذي وصلت اليه اعانك الله ووفقك

أشكرك أخي @kkhalifa1960 على الإلتفاتة الجميلة ، ولكن اسمح لي بمداخلة متفرعة . اذا كان طلب الأخ @حافظ التونسي هو وجود 0000 بعد رقم السنة ثم يبدأ الترقيم دون التأثير على الـ 0000 بحيث النتيجة تكون بهذا الشكل :- 202500001 ، 202500002 ، .... 2025000010 ، 2025000011 .... 2025000099999 = فإن اقتراحك جميل ويلبي الغرض . أما اذا كانت الفكرة كما تم تحديدها "رقم التسلسلي يتكون من رقم يحتوي على السنة الحالية و معها 5 ارقام ك 202500001" بحيث تكون بهذا الشكل :- 202500001 ، 202500002 ، 202500003 ، .... 202500010 ، 202500011 .... إلخ .... 202599999 = فأن التعديل الصحيح من جهتي سيكون للسطر الأخير بالشكل التالي :- GenerateID = CLng(yearPrefix & Format(serialPart + 1, "00000")) هنا سأضمن لك أن يكون الترقيم مكوناً من 5 خانات ، بوساطة دالة Format .. ويقبل التعديل حسب عدد الخانات التي يريدها صاحب الطلب بتغيير عدد الأصفار فقط . إلا أنني تجاهلت التقيد بعدد خانات محددة مثل ( 00000 ) . فنهاية الترقيم ستكون 202599999 . ولكن ماذا لو كان هناك سجل جديد وما زال العام 2025 لم ينتهي !؟!؟ لذا لم أقم بإضافتها أو التقيد بها أخي العزيز خليفة .

أخي @Foksh كي ينتج طلب السائل ......... السطر الاخير بالموديول بدلة بــ GenerateID = CLng(yearPrefix & "0000" & (serialPart + 1)) يجعله الله في ميزان حسناتكم .

طيب يا فؤش انا مش عارف انت فاهم واللا انت بتحلب الاجابه علشان تكون كامله هو مش مقصود انى انزل الاجابة ناقصه بقدر ما هو مقصود ان تقتصر القاعدة على الفكرة المحاسبية فقط اه وشئ تانى علشان نقول عاوزين كل شئ يبقى بنتكلم فى برنامج كبير ما هو نقطه هتجر وراها نقطه تانيه مرتبطه بيها وده مش موضوعنا مبدئيا هو مينفعش ومش منطقى ان نفس المنتج فى فاتورة واحده يتكرر يعنى كل ما تيحب تعمل عملية بيع لنفس المنتج للتجربه فى كل مره تضيف سجل جديد لعمل فاتورة جديده يا فؤش أفندى صحصح وركز كده وانا قلت ملاحظة ان القاعدة تعتمد على شئ واحد فقط ضبط الحسابات بطريقة دقيقه ومرنه للحساب لرصد وجرد المبيعات بشكل صحيح نحلل كلامك ده يا فؤش أفندي تحليل كلامك بخصوص (سيناريو الشراء المتعدد بأسعار مختلفة) الدُفعة الكمية سعر الشراء الكمية المباعة الكمية المتبقية 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

نعم .. في جدول التقدير على سبيل المثال :- 1 = مقبول 2 = جيد 3 = جيد جداً 4 = ممتاز في الكومبوبوكس سيكون مصدر جدول التقديرات وسيتم اضافة العمودين ( صحيح ؟ ) الآن في النموذج سيكون مصدر بيانات الكومبوبوكس حقل التقدير في جدول الموظفين الرئيسي ، وستكون القيمة على سبيل المثال = 4 ( رقم التقدير = ممتاز ) ولن تكون كلمة ممتاز . وطبعاً سيكون مصدر الصف للكومبوبوكس الجدول الخاص بالتقدير ( اعتقد ها ما تم تطبيقه في مثالك .. صحيح ؟ ) إن كان هذا ما تم فعله فهو ممتاز وأحسنت التطبيق .

وعليكم السلام ورحمة الله وبركاته استخدم هذه المعادلة بدون تقريب الرقم، مع عرض منزل عشرية واحدة فقط إذا وُجدت، ولا يتم عرض .0 إذا كان العدد صحيحًا =IF(D2=INT(D2); D2; INT(D2*10)/10) مثال للتوضيح العدد العشري.xlsx

وعليكم السلام ورحمة الله وبركانه وكل العام والجميع بخير لكافة اعضاء المنتدى اعتقد طلبك معادلة جزئيًا نعم، ولكن حذف الصف الأصلي تلقائيًا من شيت data → هذا غير ممكن بالمعادلات (حسب علمي والله اعلم ) اما عن طريق الكود فممكن الملف المرفق به كود يعمل تلقائيا كلما وجد كلمة معاش في شيت data في العمود H يقوم بترحيلها تلقائيا الى شيت معاشات مع حذفها من الشيت الاصلى وكذلك الترتيب التلقائي والتسلسل التلقائي في العمود A جرب تغيير تاريخ ميلاد اي اسم ليحال على المعاش ولاحظ عمل الكود ترحيل بيانات الموظف المحال للمعاش إلى شيت آخر وحذفه من قاعدة البيانات.xlsb

تفضل جرب هذا ورجاء ادخال مسارات الصورة فى العمود 10 فى شيت DbSheet او من خلال تحديد الاسم فى السجل داخل الليست بوكس وادخال الصورة المدرجة الخاصة بالموظف منظومة-الشؤون-الادارية - Copy - Copy.xlsm

مشاركة مع اساتذتى الكرام واحبابى اليك هذه الاكواد Public Function CalculateTimeDifference(startDate As Variant, endDate As Variant) As String On Error GoTo ErrorHandler Dim totalSeconds As Double Dim days As Long Dim hours As Long Dim minutes As Long Dim seconds As Long ' التحقق من أن التاريخين ليسا فارغين وهما صالحان If IsNull(startDate) Or IsNull(endDate) Then CalculateTimeDifference = "أحد التواريخ فارغ" Exit Function ElseIf Not IsDate(startDate) Or Not IsDate(endDate) Then CalculateTimeDifference = "أحد التواريخ غير صالح" Exit Function End If ' تحويل التاريخين إلى نوع Date Dim start As Date Dim endD As Date start = CDate(startDate) endD = CDate(endDate) ' حساب الفرق بالثواني totalSeconds = DateDiff("s", start, endD) ' التحقق من القيمة السالبة If totalSeconds < 0 Then CalculateTimeDifference = "تاريخ النهاية يجب أن يكون بعد تاريخ البداية" Exit Function End If ' تحويل الثواني إلى أيام days = Int(totalSeconds / 86400) ' 86400 = عدد ثواني اليوم totalSeconds = totalSeconds - (days * 86400) ' تحويل الثواني إلى ساعات hours = Int(totalSeconds / 3600) ' 3600 = عدد ثواني الساعة totalSeconds = totalSeconds - (hours * 3600) ' تحويل الثواني إلى دقائق minutes = Int(totalSeconds / 60) ' الثواني المتبقية seconds = totalSeconds - (minutes * 60) ' إرجاع النتيجة كنص CalculateTimeDifference = days & " أيام, " & hours & " ساعات, " & minutes & " دقائق, " & seconds & " ثواني" Exit Function ErrorHandler: CalculateTimeDifference = "حدث خطأ: " & Err.Description End Function Public Function CalculateTimeParts(startDate As Variant, endDate As Variant, part As String) As Long On Error GoTo ErrorHandler Dim years As Long Dim months As Long Dim days As Long Dim hours As Long Dim minutes As Long Dim seconds As Long Dim tempDate As Date ' التحقق من أن التاريخين ليسا فارغين If IsNull(startDate) Or IsNull(endDate) Then CalculateTimeParts = 0 Exit Function End If ' التحقق من ترتيب التواريخ If startDate > endDate Then CalculateTimeParts = 0 Exit Function End If ' البدء بحساب الفرقات الزمنية tempDate = startDate ' حساب الفرق في السنوات years = DateDiff("yyyy", tempDate, endDate) tempDate = DateAdd("yyyy", years, tempDate) ' حساب الفرق في الأشهر months = DateDiff("m", tempDate, endDate) tempDate = DateAdd("m", months, tempDate) ' التأكد من عدم وجود قيم سالبة بعد التعديلات If tempDate > endDate Then months = months - 1 tempDate = DateAdd("m", -1, tempDate) End If ' حساب الفرق في الأيام days = DateDiff("d", tempDate, endDate) tempDate = DateAdd("d", days, tempDate) ' حساب الفرق في الساعات hours = DateDiff("h", tempDate, endDate) tempDate = DateAdd("h", hours, tempDate) ' حساب الفرق في الدقائق minutes = DateDiff("n", tempDate, endDate) tempDate = DateAdd("n", minutes, tempDate) ' حساب الفرق في الثواني seconds = DateDiff("s", tempDate, endDate) ' التأكد من عدم وجود قيم سالبة نهائياً If months < 0 Then months = 0 If days < 0 Then days = 0 If hours < 0 Then hours = 0 If minutes < 0 Then minutes = 0 If seconds < 0 Then seconds = 0 ' إرجاع الجزء المطلوب Select Case part Case "Years": CalculateTimeParts = years Case "Months": CalculateTimeParts = months Case "Days": CalculateTimeParts = days Case "Hours": CalculateTimeParts = hours Case "Minutes": CalculateTimeParts = minutes Case "Seconds": CalculateTimeParts = seconds Case Else: CalculateTimeParts = 0 End Select Exit Function ErrorHandler: CalculateTimeParts = 0 End Function الاستعلام الاول والمعتمد على الإجراء : CalculateTimeDifference SELECT Tbl_IN_OUT.ID, Tbl_IN_OUT.Nname, Tbl_IN_OUT.Start_Day, Tbl_IN_OUT.End_Day, CalculateTimeDifference([Start_Day], [End_Day]) AS Sub_Time FROM Tbl_IN_OUT; الاستعلام الثانى والمعتمد على الإجراء : CalculateTimeParts SELECT Tbl_IN_OUT.ID, Tbl_IN_OUT.Nname, Tbl_IN_OUT.Start_Day, Tbl_IN_OUT.End_Day, CalculateTimeParts([Start_Day], [End_Day], "Years") AS Years_Diff, CalculateTimeParts([Start_Day], [End_Day], "Months") AS Months_Diff, CalculateTimeParts([Start_Day], [End_Day], "Days") AS Days_Diff, CalculateTimeParts([Start_Day], [End_Day], "Hours") AS Hours_Diff, CalculateTimeParts([Start_Day], [End_Day], "Minutes") AS Minutes_Diff, CalculateTimeParts([Start_Day], [End_Day], "Seconds") AS Seconds_Diff FROM Tbl_IN_OUT;

الكود بعد اضافه سطر مسح البيانات المرحله ومسح التسطير Option Explicit Sub Test() 'هذا الكود للمحترم النابغه ياسر خليل 'الهدف من الكود هو ترحيل اعمده معينه لاعمده اخرى معينه بالتسطير 'تم هذا الكود في 6/5/2017 'متغيرات Dim arr As Variant Dim i As Variant Dim cr As Variant Dim j As Long Dim lr As Long 'سطر لمسح النطاق Range("A4:Z1000").Clear lr = Sheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Row 'اسم شيت المصدر واسم الخليه الاولى منه arr = Sheets("Sheet1").Range("A7:K" & lr).Value 'الأعمدة المطلوب الترحيل إليها cr = Array(3, 5, 7) 'أرقام الأعمدة المطلوب ترحيلها For Each i In Array(1, 3, 5) 'اسم شيت الهدف ورقم صف صفحة الهدف Sheets("Sheet2").Cells(4, cr(j)).Resize(UBound(arr, 1)).Value = Application.Index(arr, , i) 'سطر لمسح التسطير Sheets("Sheet2").Cells(4, cr(j)).Resize(UBound(arr, 1)).Borders.Value = 0 'سطر للتسطير Sheets("Sheet2").Cells(4, cr(j)).Resize(UBound(arr, 1)).Borders.Value = 1 j = j + 1 Next i End Sub *********** لماذا تاتي البيانات المرحله دائما محاذاتها ناحيه اليمين ؟ نريد محاذاتها في الوسط

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

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

كود لعرض الاسم كاملا لمستخدم الويندوز الحالي مرفق مثال Sub btnGetFullUserName() Dim Accounts As Object, User As Object Dim ComputerName As String ' الجهاز الحالي ComputerName = "." ' احصل على مرجع لحسابات الويندوز Set Accounts = GetObject("WinNT://" & ComputerName & "") ' فلتر الحسابات حسب الاسماء Accounts.Filter = Array("user") ' افحص جميع الاسماء For Each User In Accounts ' تأكد ان المستخدم هو المستخدم الحالي للنظام If User.Name = Environ("Username") Then ' اعرض الاسم كاملا اذا وجد MsgBox "مرحبا " & User.FullName, vbInformation + vbMsgBoxRtlReading End If Next End Sub Get Full user name.zip