Foksh

أخي الكريم ، واضح أنك تريد مشروع كامل وليس مساعدة في شيء محدد

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

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

جرب احذف هذا الجزء أخي الكريم ، متابع

أبدعت أستاذنا ومعلمنا الفاضل @ابوخليل بارك الله فيك ، وغفر لك ولوالديك ، وجعله في ميزان حسناتك . اسمح لي بمداخلة صغيرة تتعلق بتوسيع عدسة المراقبة للتغييرات لتشمل أيضاً الـ Combobox ؛ بإضافة بسيطة على الجزء التالي :- ليصبح على هذا النحو ؛ If TypeOf ctlC Is TextBox Or TypeOf ctlC Is ComboBox Then

زادك الله من فضله وكرمه وجوده وعلمه ، ونفعك به 🤲 مبارك عليك أخي @محمد احمد لطفى 🥰🎉💐

دي بسيطة ، حعدل على الاستعلام وارفقه في المشاركة التالية .

المكتبات وُجدت للتخفيف من الاكواد والاستدعاءات البرمجية ، وبالعكس هي أسهل ومختصرة للوقت والجهد البرمجي . من وجهة نظري 😊 هذا كان الاستعلام اللي موجود في مشروعك 🙄 لكن ممكن تطويره طبعاً حسب حاجتك

مشاركة مع الأستاذ خليفة ، تفضلي باستبدال الجزء التالي DoCmd.OpenQuery "Dlt_Logo" بالجزء التالي Dim db As DAO.Database Dim strSQL As String Set db = CurrentDb strSQL = "UPDATE settings_Report_tbl SET settings_Report_tbl.LogoPath = Null " & _ "WHERE (((settings_Report_tbl.LogoPath)=[forms]![settings_report_frm]![LogoPath]));" db.Execute strSQL Set db = Nothing عوضاً عن الاستعلام . زي ما هو واضح من الكود ، تأكدي من المكتبة اذا موجودة عندك في الملف الأساسي اللي بتنقلي الكود له Microsoft Office 14.0 Object Library Or Microsoft Office 16.0 Object Library جسب اصدار الأوفيس عندك

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

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

الشكر موصول لك أستاذ 🤝 @محمد احمد لطفى مع إجراء بعض التعديلات على الدالة في المديول ، تم تنفيذ الفكرة لتعمل على نسخة 2010 ؛ مع العلم ان كود الاستاذ محمد يعمل على اصدار 2016 :) وهذا التعديل للفائدة العامة :- Function GetAudioFileDurationInSeconds(filePath As String) As Long Dim audioApp As Object Dim audioClip As Object On Error Resume Next Set audioApp = CreateObject("WMPlayer.OCX") Set audioClip = audioApp.newMedia(filePath) On Error GoTo 0 If audioClip Is Nothing Then GetAudioFileDurationInSeconds = -1 Else GetAudioFileDurationInSeconds = audioClip.duration End If Set audioClip = Nothing Set audioApp = Nothing End Function

جاري التجربة 🥰

السلام عليكم أخواني وأساتذتي الكرام .. لدي مشروع اقوم بتنفيذه ، وقد وقفت عند نقطة مهمة جداً لي وهي أنني اريد جلب مدة ملف صوتي بحيث تظهر في مربع نص بالثانية ( يعني لو المدة 1 دقيقة ونصف ) تكون النتيجة 90 ثانية .

أخي @tiger wanted ، لا أعتقد أن طلبك ممكن تحقيقه فيما يخص التحكم بشريط التمرير. لكن قد يكون ذلك بطريقة أخرى وهي التحكم بتنقل السجلات نفسها بالطريقة المعروفة . التحريك للأسفل DoCmd.GoToRecord , , acNext التحريك للأعلى DoCmd.GoToRecord , , acPrevious

جرب هذا التعديل ، حسب ما فهمت Main.accdb

مساهمة خارجية ، قم بتجربة هذه الفكرة Move_Frm.accdb

لتحقيق الهدف على ما اعتقد قم باضافة شرط آخر وهو :- قم باستبدال هذا الجزء بما يلي If Day(startDate) = Day(endDate) + 1 Then days = 0 Elseif days > 30 Then months = months + 1 days = days - 30 End If جرب و وافني بالرد

تأييداً لكلام الأستاذ @kkhalifa1960 ، أرجو تجربة التعديل بهذا الكود ، Private Sub Calc_Click() نص3 = DateAdd("d", DateDiff("d", [بداية العمل], [نهاية العمل]) / 2, [بداية العمل]) Dim startDate As Date Dim endDate As Date Dim years As Integer Dim months As Integer Dim days As Integer startDate = [بداية العمل] endDate = [نهاية العمل] years = DateDiff("yyyy", startDate, endDate) months = DateDiff("m", DateAdd("yyyy", years, startDate), endDate) days = DateDiff("d", DateAdd("m", months, DateAdd("yyyy", years, startDate)), endDate) If Day(endDate) < Day(startDate) Then months = months - 1 days = DateDiff("d", DateAdd("m", months, DateAdd("yyyy", years, startDate)), endDate) End If If Month(endDate) < Month(startDate) Then months = 12 + Month(endDate) - Month(startDate) End If If Day(startDate) = Day(endDate) + 1 Then days = 0 End If Dim result As String result = years & " سنة " & months & " شهر " & days & " يوم" نص5 = result نص10 = days نص12 = months نص14 = years End Sub

ابشر ، بتم التعديل وبرفق الملف

أرجو المعذرة أخي الكريم ،، تفضل هذا المرفق Diff.accdb

تفضل التعديل Function CalcAge(StartDate As Date, EndDate As Date) As String Dim years As Integer Dim months As Integer Dim days As Integer Dim totalMonths As Integer totalMonths = Int(DateDiff("m", StartDate, EndDate)) + _ (EndDate < DateSerial(Year(EndDate), Month(EndDate), Day(StartDate))) years = Int(totalMonths / 12) months = totalMonths Mod 12 ' تحويل 30 يومًا إلى 01 شهر If days = 30 Then months = months + 1 days = 0 End If CalcAge = years & " سنة و " & months & " شهر و " & days & " يوم" End Function