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

في إحدى التجارب التي لفتت انتباهي لهذه النقطة كانت عندما قمت بتصميم مشروع قديم ،وكنت تلقائياً بعد فتح قاعدة البيانات وإضافة المكتبات التي اريدها للمشروع ، أقوم بشكل افتراضي بتسمية المشروع في محرر الأكواد إلى اسم المشروع الذي أصممه مطابقاً لاسم قاعدة البيانات التي تم انشاءها . فمثلاً اسم المشروع = "Accounting Software" على سطح المكتب ، واسم المشروع في محرر الأكواد كما أشرت سابقاً = "Accounting Software" أيضاً ، فصادفتني مشكلة عند بدء تشغيل المشروع من نموذج البداية كالمعتاد وهي انه ظهرت رسالة خطأ في أوامر بدء التشغيل للنموذج . ولأنها عادة كانت عندي بالتسمية المتشابهة كما أشرت أعلاه ، قمت بتغيير اسم المشروع في محرر الأوامر . وهنا كانت النقطة الفاصلة التي لفتت انتباهي ان الرسالة لم تظهر أبداً . وهذا ما جعلني أطرح هذه النقطة . لا أعلم السبب الحقيقي !! ولكني في حينها لم أذهب الى البحث عن السبب بشكل جدي .

وعليكم السلام ورحمة الله تعالى وبركاته قم بإظافة Textbox جديدة مثلا بإسم TextBoxSearch وإظافة الأكواد التالية Private Sub TextBoxSearch_Change() Dim i As Long, count As Long, sList() As Variant Dim Search As String, tmp() As String, n() As String Search = LCase(Replace(Trim(TextBoxSearch.Text), " ", "")) If Not IsArray(r) Or UBound(r) < 0 Then Exit Sub ReDim tmp(UBound(r)) ReDim n(UBound(r)) For i = 0 To UBound(r) If InStr(LCase(Replace(r(i, 0), " ", "")), Search) > 0 Then tmp(count) = r(i, 0) n(count) = r(i, 1) count = count + 1 End If Next i If count > 0 Then ReDim sList(0 To count - 1, 0 To 1) For i = 0 To count - 1 sList(i, 0) = tmp(i) sList(i, 1) = n(i) Next i ListBox1.List = sList Else ListBox1.clear End If Counter = "عدد التقارير: " & ListBox1.ListCount End Sub "=============================== Private Sub TextBoxSearch_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If Not iGblInhibitTextBoxEvents Then TextBoxSearch.value = "" End If End Sub للطباعة إختر ما يناسبك Private Sub CommandButton6_Click() On Error GoTo ClearApp If Me.ListBox1.ListIndex = -1 Then MsgBox "يرجى تحديد الملف المرغوب طباعته", vbExclamation, "إنتبــــاه" Exit Sub End If WebBrowser1.ExecWB 6, 1 '<===== ' عرض نافذة الطباعة ' WebBrowser1.ExecWB 6, 2 '<=====' طباعة مباشرة Exit Sub ClearApp: End Sub قاعدة بيانات الموظفين 3.rar

العفو أخي الكريم ,,

استاذ @Foksh شكرا لك بارك الله فيك تحياتي

جميل جداً .. اذا تفضل هذا الاستعلام بعد ضبط الفرز بشكل تصاعدي للتاريخ SELECT R.[تاريخ المستند], R.[نوع المستند], R.[رقم المستند], W.[اسم المادة ومواصفاتها], W.[الرقم الرمزي], IIf(R.[نوع المستند]='وارد مخزني',W.[الكمية رقما],Null) AS [كمية واردة], IIf(R.[نوع المستند]='صادر مخزني',W.[الكمية رقما],Null) AS [كمية مصروفة], (SELECT Sum(IIf(R2.[نوع المستند]='وارد مخزني', W2.[الكمية رقما], 0)) - Sum(IIf(R2.[نوع المستند]='صادر مخزني', W2.[الكمية رقما], 0)) FROM [راس الوارد] AS R2 INNER JOIN [اطراف الوارد] AS W2 ON R2.[كود المستند] = W2.[كود المستند] WHERE W2.[الرقم الرمزي] = W.[الرقم الرمزي] AND ( R2.[تاريخ المستند] < R.[تاريخ المستند] OR ( R2.[تاريخ المستند] = R.[تاريخ المستند] AND R2.[رقم المستند] < R.[رقم المستند] ) OR ( R2.[تاريخ المستند] = R.[تاريخ المستند] AND R2.[رقم المستند] = R.[رقم المستند] AND W2.[كود الطرف] <= W.[كود الطرف] ) ) ) AS [الرصيد التراكمي] FROM [راس الوارد] AS R INNER JOIN [اطراف الوارد] AS W ON R.[كود المستند] = W.[كود المستند] ORDER BY R.[تاريخ المستند], W.[الرقم الرمزي], R.[تاريخ المستند], R.[رقم المستند], W.[كود الطرف];

حسناً أخي @Ahmed_J ، قبل الشروع في تنفيذ فكرتك ، هل المطلوب تحقيقه بهذه النتيجة ؟؟؟ Query3 تاريخ المستند نوع المستند رقم المستند اسم المادة ومواصفاتها الرقم الرمزي كمية واردة كمية مصروفة الرصيد التراكمي 2025-05-06 وارد مخزني 46324 ورق A4 11111 10 10 2025-05-08 صادر مخزني 100 ورق A4 11111 1 9 2025-05-09 صادر مخزني 45 ورق A4 11111 5 4 2025-05-09 صادر مخزني 45 ورق A4 11111 3 1 2025-05-06 وارد مخزني 46324 ورق A3 22222 8 8 2025-05-09 صادر مخزني 45 ورق A3 22222 5 3

السلام عليكم حسب قهمى لطلبك ترتيب حسب اللون.xlsb

اخي احمد ، استثني حقل تاريخ آخر حركة فليس له علاقة في نتيجة الاستعلام 😅 . حتى حقل نوع آخر حركة لا يفيدك بشيء 😇 . فما يهمك هو الرصيد التراكمي النهائي. أما خلاف ذلك فأعتقد انني لم استوعب هدفك جيداً.

تفضل ، هذا الاستعلام للتجربة .. SELECT W.[اسم المادة ومواصفاتها], W.[الرقم الرمزي], W.[وحدة القياس], Sum(IIf(R.[نوع المستند]='وارد مخزني',W.[الكمية رقما],0))-Sum(IIf(R.[نوع المستند]='صادر مخزني',W.[الكمية رقما],0)) AS [الكمية الموجودة], Max(R.[تاريخ المستند]) AS [تاريخ آخر حركة], (SELECT TOP 1 R2.[نوع المستند] FROM [راس الوارد] AS R2 INNER JOIN [اطراف الوارد] AS W2 ON R2.[كود المستند] = W2.[كود المستند] WHERE W2.[الرقم الرمزي] = W.[الرقم الرمزي] ORDER BY R2.[تاريخ المستند] DESC, R2.[رقم المستند] DESC, W2.[كود الطرف] DESC ) AS [نوع آخر حركة] FROM [اطراف الوارد] AS W INNER JOIN [راس الوارد] AS R ON W.[كود المستند] = R.[كود المستند] GROUP BY W.[اسم المادة ومواصفاتها], W.[الرقم الرمزي], W.[وحدة القياس]; النتيجة = Query2 اسم المادة ومواصفاتها الرقم الرمزي وحدة القياس الكمية الموجودة تاريخ آخر حركة نوع آخر حركة ورق A3 22222 بند 3 2025-05-09 صادر مخزني ورق A4 11111 بند 1 2025-05-09 صادر مخزني

لا مشكلة ، ولكن في المرفق لا يوجد نماذج !!!

وعليكم السلام ورحمة الله وبركاته ، رغم أنني لا أشجع دائماً على استخدام المسميات العربية للحقول والجداول ، إلا أنه وعلى ما يبدو لا خلاص من النُصح بخصوص هذه النقطة . على العموم .. من خلال جداولك التي ارفقتها ، وبناءً على القيم التي فيها كحركة وارد للصنف ، في جدولك مادتين هما :- اطراف الوارد اسم المادة ومواصفاتها الرقم الرمزي ورق A4 11111 ورق A3 22222 ورق A4 11111 ورق A3 22222 ورق A4 11111 ورق A4 11111 هل هذا صحيح أولاً ؟ أي أن الرقم الرمزي هو معرف المادة ؟؟؟؟ ان كان ما توضح لي صحيحاً ، فإنه كنتيجة الوارد سيكون عندك الناتج كالآتي :- اطراف الوارد اسم المادة ومواصفاتها الرقم الرمزي الكمية الموجودة ورق A4 11111 19 ورق A3 22222 13 هل هذا التصور صحيح ؟؟ أم ان النتيجة المتوقعه = Query1 اسم المادة ومواصفاتها الرقم الرمزي الكمية الموجودة ورق A3 22222 3 ورق A4 11111 1

ما دفعني الى البحث في الانترنت عن بعض المصادر التي تتعلق بهذه النقطة . هذه بعض الصفحات التي تحدثت عن المشكلة التي ذكرتها سابقاً :- توضح مايكروسوفت أن استخدام نفس الاسم لمشروع VBA ( و / أو ) وحدة أو مكتبة مرجعية يمكن أن يؤدي إلى تعارضات ، ويُنصح بتغيير أحد الأسماء لتجنب ذلك . المصدر : Microsoft Learn . تشير مايكروسوفت إلى أن تسمية مشروع VBA بنفس اسم كائن موجود في آكسيس ( مثل "Form" أو "Application" ) يمكن أن يؤدي إلى تعارضات ، وقد يتم تعديل الاسم تلقائياً بإضافة شرطة سفلية لتجنب ذلك . المصدر : Microsoft Learn . في منتديات الدعم الخاصة بمايكروسوفت ، أبلغ مستخدمون عن ظهور أخطاء عند محاولة إضافة مراجع لمكتبات مثل "Microsoft DAO 3.6 Object Library" بسبب تعارض الأسماء مع وحدات موجودة بنفس الاسم . المصدر: Microsoft Community . ⚠️ هل يمكن أن يؤدي ذلك إلى حذف الأكواد ❓ بينما تعارض الأسماء لا يؤدي مباشرة إلى حذف الأكواد ، إلا أنه قد يتسبب في تلف مشروع VBA ، مما يؤدي إلى اختفاء الوحدات النمطية أو عدم القدرة على الوصول إليها . في بعض الحالات ، قد تظهر رسائل خطأ مثل "The database cannot be opened because the VBA project contained in it cannot be read" عند فتح قاعدة البيانات . المصدر : Stackoverflow .

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

اللهم إنا نسألك بأسمائك الحسنى وبصفاتك العلا وبرحمتك التي وسعت كلّ شيء، أن تمنّ عليه بالشفاء العاجل، وألّا تدع فيه جرحاً إلّا داويته، ولا ألماً إلا سكنته، ولا مرضاً إلا شفيته، وألبسه ثوب الصحة والعافية عاجلاً غير آجل، وشافِه وعافِه واعف عنه، واشمله بعطفك ومغفرتك، وتولّه برحمتك يا أرحم الراحمين.َ

ممكن تعطينا تفاصيل اكثر لوسمحت

دي بسيطة جداً .. اليوم ان شاء الله في جهاز البيت لدي نسختين 2010 - 32 / 2026 - 64 ، وفي العمل لدي النسخة 2019 - 64 . خطر ببالي نقطة حصلت معي سابقاً وكانت فعلاً سبب مشكلة في إحدى قواعد البيانات . وهي تغيير اسم المشروع في محرر الأكواد كما في الصورة التالية .. وهذه القاعدة نفسها التي ارفقها أخونا طاهر ولكن بعد تغيير اسم المشروع ، مع عدم تغيير نواة الأكواد من 32 إلى 64 ( حسب النسخة الحالية التي لدي الآن = 2016 - 64 ) ش ع2025.zip

فؤش تقدر تجربها على اوفيس 2010 32 بت ؟ هو عنده اوفيس 10 32 بت وبيقول كل القواعد شغاله الا دى انا عملت المرفق الاخير ده قاعده جديده استوردت كل شئ من القديمه اليها اضفت كلمة مرور للحماية من الانتى فايروس عطلت كل الاكواد اللى بها مشاكل وحولت اى شئ بس لتفادى مشاكل الانويه لان للاسف انا 64 بت القاعده تعمل معى بدون مشاكل ولكن هو نفس المشكله واللى هيجننى ما فى اى اكواد اوتو اكسيك ولا نموذج بدايه القاعده بمجرد الفتح بتظهر رسالة انه سوف يحذف الاكواد الحل الاخير اللى عندى تفعيل الاوفيس لانه غير مفعل المشكله ما عنده انترنت وما قدرت افوت انى ديسك ارسلت له فى رسائل واتس التفعيل لعله يكون السبب ولنا لقاء يوم الاحد القادم لنكمل

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

جرب هذه القاعده للعلم فقط القاعده مجرد لتجربة مشاكل الفتح والتأكد من وجود الاكواد تحويل الاكواد غير صحيح ولم ولن اهتم بالتصحيح الان عطلت الكثير من الاكواد نظرا لعدم وجود عناصرها فى النماذج لذا معظم الاكواد لن تكون صحيحة تمام القاعده فقط لتجرب مشكلة حذف الاكواد من عدم حذفها 2025.zip

1. رجاء استعمال النسخة التي ارفقتها لك: 1628.2_Import_New_DB_Compact_Repair.accdb 2. اوقف البرامج المضادة للفيروسات ، ومن ضمنها التي تاتي مع الوندوز 10 ، Windows Security 3. كذلك اوقف جميع البرامج التي تراقب برامج الكمبيوتر مثل Adware 4. افصل الحاسبة عن الشبكة والانترنت 5. ادخل في البرنامج بينما تكون ماسك مفتاح الشف ، فهل الاكواد جميعها موجودة؟ من الواضح هناك برنامج خارجي يعتقد ان برنامجك فايروس ، فيقوم بحذف جميع الاكواد ، وخصوصا اذا كانت الحاسبة جزءً من شبكة الشركة ، وهذه الشركة لديها شروط قوية على نوع البرامج الممكن استعمالها

إللهم أذهب البأس ربّ النّاس، اشف وأنت الشّافي، لا شفاء إلا شفاؤك، شفاءً لا يغادر سقماً، أذهب البأس ربّ النّاس، بيدك الشّفاء، لا كاشف له إلّا أنت يارب العالمين

اللهم الشفاءالعاجل ... والسلامة الدائمة ... بحق اسمك الاعظم ونبيك المكرم ...

New Microsoft Access Database.rar

ليس من طبعي عدم استكمال بداية قد بدأتها ،ولكنك اخي الكريم في كل مرة تقوم بتوجيه طلب مختلف ، أو انك من البداية لم تقم بتوضيح المطلوب بشكل جيد . وها ما جعلني استنكف عن المتابعة . لكن على العموم ، اتمنى ان لايكون الهدف في رأسك غير الذي أشرت اليه مؤخراً . ولذا فهذه تجربتي علها تكون ما تريده . المديول سيصبح بهذا الشكل ( التعديل فقط على الدالة الأخيرة ) .. Function DurationToWords(StartDate As Variant, EndDate As Variant) As String Dim diff As Integer If IsNull(StartDate) Or IsNull(EndDate) Then DurationToWords = "لم يتم إدخال تاريخين للمقارنة" Exit Function End If diff = DateDiff("yyyy", StartDate, EndDate) If Month(EndDate) < Month(StartDate) Or _ (Month(EndDate) = Month(StartDate) And Day(EndDate) < Day(StartDate)) Then diff = diff - 1 End If Select Case diff Case Is < 0 DurationToWords = "تاريخ غير صالح" Case 0 DurationToWords = "أقل من سنة" Case 1 DurationToWords = "سنة واحدة" Case 2 DurationToWords = "سنتان" Case 3 To 10 DurationToWords = NumberToArabicWords(diff, True) & " سنوات" Case Else DurationToWords = NumberToArabicWords(diff, True) & " سنة" End Select End Function Function NumberToArabicWords(ByVal Number As Long, Optional IsFeminine As Boolean = False) As String Dim UnitsMasc, UnitsFem, Tens, TeensMasc, TeensFem, Hundreds UnitsMasc = Array("", "واحد", "اثنان", "ثلاثة", "أربعة", "خمسة", "ستة", "سبعة", "ثمانية", "تسعة") UnitsFem = Array("", "واحدة", "اثنتان", "ثلاث", "أربع", "خمس", "ست", "سبع", "ثمان", "تسع") TeensMasc = Array("عشرة", "أحد عشر", "اثنا عشر", "ثلاثة عشر", "أربعة عشر", "خمسة عشر", "ستة عشر", "سبعة عشر", "ثمانية عشر", "تسعة عشر") TeensFem = Array("عشرة", "إحدى عشرة", "اثنتا عشرة", "ثلاث عشرة", "أربع عشرة", "خمس عشرة", "ست عشرة", "سبع عشرة", "ثماني عشرة", "تسع عشرة") Tens = Array("", "عشرة", "عشرون", "ثلاثون", "أربعون", "خمسون", "ستون", "سبعون", "ثمانون", "تسعون") Hundreds = Array("", "مئة", "مئتان", "ثلاثمئة", "أربعمئة", "خمسمئة", "ستمئة", "سبعمئة", "ثمانمئة", "تسعمئة") Dim Words As String Dim n As Long Dim h, t, u As Integer If Number = 0 Then NumberToArabicWords = "صفر" Exit Function End If If Number = 10 Then NumberToArabicWords = IIf(IsFeminine, "عشر", "عشرة") Exit Function End If If Number > 999 Then Dim Thousands As Long Thousands = Number \ 1000 Words = NumberToArabicWords(Thousands, False) & " ألف" n = Number Mod 1000 If n > 0 Then Words = Words & " و" & NumberToArabicWords(n, IsFeminine) NumberToArabicWords = Words Exit Function End If h = Number \ 100 t = (Number Mod 100) \ 10 u = Number Mod 10 If h > 0 Then Words = Hundreds(h) If (Number Mod 100) >= 11 And (Number Mod 100) <= 19 Then If Words <> "" Then Words = Words & " و" If IsFeminine Then Words = Words & TeensFem((Number Mod 100) - 10) Else Words = Words & TeensMasc((Number Mod 100) - 10) End If Else Dim UnitsArray UnitsArray = IIf(IsFeminine, UnitsFem, UnitsMasc) If t > 1 Then If u > 0 Then If Words <> "" Then Words = Words & " و" Words = Words & UnitsArray(u) & " و" & Tens(t) Else If Words <> "" Then Words = Words & " و" Words = Words & Tens(t) End If ElseIf u > 0 Then If Words <> "" Then Words = Words & " و" Words = Words & UnitsArray(u) End If End If NumberToArabicWords = Words End Function Function GetDurationStatus(StartDate As Variant, EndDate As Variant) As String If IsNull(StartDate) Or IsNull(EndDate) Then GetDurationStatus = "" Exit Function End If If EndDate < Date Then GetDurationStatus = "Expired" Else GetDurationStatus = "Current" End If End Function وفي التنسيق الشرطي استدعينا الدالة بها الشكل كما في الصورة :- حيث تم استدعاء الدالة مع تحديد اذا كانت النتيجة = Expired أو Current لتحديد اللون . المرفق الأخير :- تفقيط التاريخ 1 (2).accdb

لسلام عليكم لدي ملف اكسس فيه جدولين راس واطراف للوارد المخزني والصادر المخزني في جدول واحد المطلوب معرفة الرصيد التراكمي (كمية الرصيد) للمواد عند ادخال ماده جديده للمخزن (وارد مخزني) او صرف ماده من المخزن (صادر مخزني) وشكرا Database1.accdb