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

و كذلك هذا حل أخر مع أخي @essam rabea DATA14.mdb

بالتأكيد السبب هو كثرة الأوامر داخل الاستعلام واسهل طريقة هي تجزئة الاستعلام انظر مثالك بعد التعديل نسبة الاستهلاك1 .rar

يا سلام ، انا واخي السيد @husamwahab حلينا الموضوع ، وبدون مشاركة 🙂 يعني لو كان اسمي فقط ، كنتوا بتقولون: عماني وساحر 🙂 جعفر

أ.abouelhassan ما تقدم به أخي الفاضل د.كاف يار يفي بكل ما طلبت فهو يبحث عن رقم الفاتورة وحدها مع مراعاة ان يكون حقل المبلغ فارغا وكذلك يبحث عن المبلغ وحده مع مراعاة ان يكون حقل رقم الفاتورة فارغا لا فرق عند الفتح ان كان الفورم يفتح بكل البيانات ام لا. فإن كانت المشكلة فى ظهور كافة البيانات فيمكنك إخفاء التفصيل ومن ثم إعادة إظهاره عند البحث كما يلي فى حدث عند الفتح للفورم أضف الكود التالي Me.Form.Section(0).Visible = False وفي حدث بعد التحديث للبحث برقم الفاتورة وكذلك للبحث بالمبلغ Me.Form.Section(0).Visible = True وأرفق لك طريقة أخرى بإستخدام الإستعلام عسى أن تفيد DATA14 (3).rar

تفضل هذا التعديل اخي الكريم تم اضافة امر انشاء نسخة احتياطية DATA14.mdb

السلام عليكم 🙂 المرفق يحتوي على النسختين mdb و accdb ، ويعمل على النواتين 32بت و 64 بت 🙂 النسخة السابقة: عندما يعطي برنامج الاكسس اخطاء - النسخة رقم 3 - قسم الأكسيس Access - أوفيسنا (officena.net) بعض الاوقات عند تشغيل برنامج اكسس ، نجد انه يغلق بدون سبب ، بمثل هذه الرسالة: . او يُظهر اخطاء ، مثل هذه الرسائل وغيرها : . . . هذا معناه ان برنامجك يحتاج تنظيف من الاخطاء التي فيه ، او يحتاج الى استعادة حيويته مرة اخرى ، بالتنظيف والصيانة 🙂 وعادة نقوم بهذا العمل على برنامج الواجهات FE ، ولكن برنامج الجداول BE يستفيد منه كذلك. نافذة البرنامج : . 1. نختار الملف ، سواء mdb او accdb ، اما ملفات mde و accde ، فلن تستفيد من Decompile/Compile ، ولكنها ستستفيد من الضغط والاصلاح ، وعمل نسخ اضافية ، 2. اذا البرنامج فيه كلمة سر (ليس كلمة سر المستخدمين ، ولا كلمة سر الكود VBE) ، فيمكنك كتابة كلمة السر هنا ، وسيقوم البرنامج بحفظه/نسخه في ذاكرة الكمبيوتر ، وتستطيع استعمال الالصاق Ctl+v عندما يسألك البرنامج ، كما يقوم البرنامج بإستخدامه في فتح برنامجك لمراجعة الاخطاء. اذن هناك خطوة يمكن للبرنامج ان يستخدم كلمة السر مباشرة ، وهناك خطوة يجب عليك ادخال كلمة السر عن طريق اللصق Ctl+v ، تم إضافة ميزة عمل النسخ الاحتياطية لبرنامجك ، بحيث تحفظ نسخة من برنامجك بعد التنظيف ، في المجلد الذي تختاره ، ويكون الحفظ المسلسل هكذا : . يعني بدل ان تحفظ نسخة من برنامجك بطرقك الخاصة ، تستطيع وبعد تعديل برنامجك ، ان تتأكد انه خالي من الشوائب ، ويعمل نسخه منه تلقائيا 🙂 وهناك عدة طرق لإختيار مجلد الحفظ: 3. حفظ الملف في نفس مجلد البرنامج ، 4. اختار المجلد ، وبعد اختياره ، تستطيع ان تنقر على الزر 9 ليقوم البرنامج بحفظ هذا المجلد/المسار في البرنامج للمرات القادمة ، 5. اول مسار تريد حفظه هو: استعمل الخطوة 4 في فتح المجلد الرئيسي لحفظ النسخ الاحتياطية (واذا ما كان عندك ، فقم بعمله من الآن) ، ثم احفظ المجلد/المسار بالزر 9. وبعدها ، البرنامج تلقائيا يختار هذا المجلد (اذا قمت بحفظه بواسطة الزر 9) كلما فتحت البرنامج ، اي انه اول سجل في الجدول ، 6. عن طريق الخطوة 4 ، تستطيع حفظ اي عدد من المجلدات ، ولاحقا تستطيع ان تختار هذا المجلد لحفظ النسخة الاحتياطية فيه ، 7. عدم عمل نسخ احتياطية ، للأسف الشديد 😞 8. عند اختيار اي من الاختيارات اعلاه ، سيضع البرنامج مسار مجلد النسخ الاحتياطية هنا ، 11. الآن نطلب من البرنامج ان يقوم بعمله ، بالخطوات التالية : أ. يحفظ نسخة من البرنامج وقبل مساسه (حتى اذا لا قدر الله وحصلت مشكلة في العمل ، يمكنك الرجوع لهذه النسخة) ، ويقوم البرنامج بعمل النسخة في مجلد برنامجك ، بإضافة bak_ في نهاية اسم الملف ، كما في الصورة ، واذا احتجت لإستعمال الملف لاحقا ، فقط قم بحذف bak_ وسيعمل البرنامج : ب. ضغط واصلاح : لما تحذف سجلات من برنامجك ، فإن البرنامج يعطي اشارة الى الجدول بإخفائه ، ولا يقوم بحذفه إلا بعد الضغط والاصلاح ، عند عمل فهرسة لحقول في الجدول ، فإن البرنامج يحتاج الى ضغط واصلاح حتى يقوم بترتيب اعدادات الفهرسة ، عند العمل على البرنامج لفترة طويلة بإضافات وتعديل وحذف ، فالبرنامج يحتاج الى ضغط واصلاح لإعادة ترتيب الفهرسة لسرعة عمل البرنامج ، قد يتم خطأ في تسجيل سجل ، ربما بسبب انطفاء الكهرباء ، او اغلاق الكمبيوتر وبدون اغلاق البرنامج ، وهذا السجل يجعل الجدول لا يعمل بطريقة صحيحة ، والضغط والاصلاح يحل هذه الاشكالية ، البرنامج عبارة عن ملف في الكمبيوتر ، ولما تعمل البرنامج ، فإن الكمبيوتر يحفظ البرنامج على المكان الفارغ من القرص الصلب ، ولما تضيف سجلات جديدة ويكبر حجم البرنامج ، فقد يحفظ الكمبيوتر الجزء الجديد في مكان آخر على القرص الصلب ، مكان غير ملاصق للجزء الاصل (وهذه طريقة حفظ الكمبيوتر للملفات) ، وبهذه الطريقة يصبح الملف موجدا على اجزاء مختلفة من القرص الصلب ، مما يجعل البرنامج ابطأ ، ولما تعمل ضغط واصلاح ، فإن الاكسس يقوم بحساب المساحة المطلوبة للبرنامج ، ثم يقوم بعمل برنامج جديد في مكان جديد على القرص الصلب ، وينسخ البرنامج اليه ، مما يجعل البرنامج اسرع ، بالاضافة الى امور اخرى لا يتم حلها إلا بالضغط والاصلاح ، الضغط والاصلاح لا علاقة له بالكود ، ولا يقوم بفحصه. ج. Decompile : لما نكتب الكود ، الاكسس يحتفظ بكل سطر بلغة P-Code الخاصة بمايكروسوفت (والتي تُستخدم لبعض البرامج الاخرى كذلك) ، وعند تنفيذ الكود ، فالاكسس ينفذ كود لغة P-Code ، وفي بعض الاحيان من كثرة التعديلات على الكود ، فإنه لا يتم تحديث P-Code بطريقة صحيحة ، فينتج عنه رسائل اخطاء اكسس ولا يعمل البرنامج بطريقة صحيحة ، وعند عمل Decompile ، فالاكسس يحذف كود P-Code القديم ، ويسجل فيه كود جديد من VBA ، مما يجعل البرنامج اصغر في الحجم زيادة في الكفائة. د. Compile : بهذه الطريقة ، نتأكد من عدم وجود اخطاء في الكود ، وبقايا ومخلفات ، مثل: لما نحذف كائنات في النموذج/التقرير ، ولا نحذف الحدث الخاص بها ، فالكود يجب حذفة ، لعدم وجود الحدث الي يستعمله ، لما نحذف كائن في النموذج/التقرير ، وفي الكود نكون قد اعطيناه قيمة ، فيجب حذف المسمى من الكود ، عند كتابة كود بطريقة غير صحيحة وغير مكتملة ، فيجب تصحيحها ، وهذه الخطوه مهم لتحويل البرنامج الى mde او accde . يحاول البرنامج القيام بهذا العمل لبرنامجك ، ولكنه اذا لم يستطيع ويحصل على اخطاء ، فإنه يخبرك بهذا ، ويخبرك مكان الخطأ في الكود ، سواء وحدة نمطية او نموذج او تقرير ، ويعطيك مثل الرسالة التالية ، والتي اذا اخترت نعم ، فيوقف البرنامج ، . ويأخذك لبرنامجك الى نافذة الكود VBE ، ثم يجب عليك ان تعمل التالي يدويا: . وتُصلح الاخطاء التي في برنامجك ، الى ان لا يعطي برنامجك اخطاء اخرى ، وبعدها تستطيع ان ترجع الى البرنامج ليقوم جميع الخطوات مرة اخرى. هـ. اذا اشتغلت خطوات البرنامج وبدون اخطاء ، فهنا يقوم البرنامج بعمل نسخة احتياطية من برنامجك ، وبالتسلسل الصحيح ، وفي المجلد الذي اخترته. 12. البرنامج يخبرك عن الخطوات التي تمت 🙂 جعفر Decompile_4.accdb..zip Decompile_4.mdb..zip Decompile_4.2.accdb.zip

الضفحة Salim من هذا الملف TwoDates.xlsm

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

تم التعديل على الماكرو Private Sub CommandButton1_Click() Dim D As Worksheet Dim Y As Worksheet Dim F_rg As Range Dim How_many%, I%, x%, Ro% Dim Arr_sh(), arr_From() Dim Bool As Boolean Arr_sh() = Array("B8", "B47", "B86") arr_From = Array("E10", "E12", "E14", "H10", "H12", _ "H14", "F16") Set D = Sheets("Data") Set Y = Sheets("Youmia") ' For I = LBound(arr_From) To UBound(arr_From) ' D.Range(arr_From(I)) = Chr(Application.RandBetween(65, 90)) ' Next For I = LBound(arr_From) To UBound(arr_From) If D.Range(arr_From(I)) = vbNullString Then MsgBox "بيانات الحالة غير مكتملة" & Chr(10) & _ "أكمل البيانات", 524352 Exit Sub End If Next For I = 0 To 2 How_many = Application.CountA(Y.Range(Arr_sh(I)).Resize(30)) Bool = IIf(How_many = 30, True, False) If Not Bool Then Exit For Next With Y.Range(Arr_sh(I)).Cells(1).Offset(How_many) For I = LBound(arr_From) To UBound(arr_From) .Offset(, I) = D.Range(arr_From(I)) Next End With For I = LBound(arr_From) To UBound(arr_From) D.Range(arr_From(I)) = vbNullString Next MsgBox "تمت إضافة البيانات", vbInformation, "Done" End Sub

تم التعديل بحيث يقوم الماكرو باضافة الشيتات الى الــ Array اوتوماتيكياً Sub Get_From_Other_WB() Dim mPath$, OtherWB As Workbook Dim F_Name, TS$, m% Dim arr(), itm, x 'arr = Array("Page1", "Page2", "Page3", "Page4") Application.ScreenUpdating = False m = 4 mPath = ThisWorkbook.Path & "\" mPath = mPath & "Main.xlsx" Set OtherWB = Workbooks.Open(mPath) For i = 1 To OtherWB.Sheets.Count ReDim Preserve arr(i - 1) arr(i - 1) = OtherWB.Sheets(i).Name Next OtherWB.Close If UCase(ActiveSheet.Name) <> "TOTAL" Then GoTo BAY_BAY_YA_HILWEEN With Sheets("TOTAL") .Cells(4, "D").Resize(UBound(arr) + 1).ClearContents mPath = ThisWorkbook.Path & "\" For Each itm In arr F_Name = mPath & "[Main.xlsx]" F_Name = "='" & F_Name & itm & "'!B2" .Cells(m, "D").Formula = F_Name m = m + 1 F_Name = "" Next .Cells(4, "D").Resize(UBound(arr) + 1).Value = _ .Cells(4, "D").Resize(UBound(arr) + 1).Value End With BAY_BAY_YA_HILWEEN: Application.ScreenUpdating = True End Sub ALl_SUM_1.xlsm Main.xlsx

تغيير اسماء الشيتات الى Data و Youmiya Private Sub CommandButton1_Click() Dim D As Worksheet Dim Y As Worksheet Dim F_rg As Range Dim How_many%, I%, x%, Ro% Dim Arr_sh(), arr_From() Arr_sh() = Array("B8", "B47", "B86") arr_From = Array("E10", "E12", "E14", "H10", "H12", _ "H14", "F16") Set D = Sheets("Data") Set Y = Sheets("Youmia") ' For I = LBound(arr_From) To UBound(arr_From) ' D.Range(arr_From(I)) = Chr(Application.RandBetween(65, 90)) ' Next For I = LBound(arr_From) To UBound(arr_From) If D.Range(arr_From(I)) = vbNullString Then MsgBox "بيانات الحالة غير مكتملة" & Chr(10) & _ "أكمل البيانات", 524352 Exit Sub End If Next For I = 0 To 2 If Application.CountA(Y.Range(Arr_sh(I)).Resize(30)) < 30 Then How_many = Application.CountA(Y.Range(Arr_sh(I)).Resize(30)) End If Exit For Next With Y.Cells(How_many + 8, "B") For I = LBound(arr_From) To UBound(arr_From) .Offset(, I) = D.Range(arr_From(I)) Next End With For I = LBound(arr_From) To UBound(arr_From) D.Range(arr_From(I)) = vbNullString Next MsgBox "تمت إضافة البيانات", vbInformation, "Done" End Sub Osama One_sheet.xlsm

شكرا اخ سليم

عليكم السلام - جرب هذا الملف Private Sub Worksheet_Change(ByVal Target As Range) ActiveSheet.Unprotect ActiveCell.Offset(1, 0).Select ActiveSheet.Protect End Sub File.xlsm

لحسن كتابة الكود ونسخه ولصقه تم العمل على 1- تغيير اسماء الملفات الى (ALl_SUM / تجميع ) و (Main /الرئيسي) 2- يجب ان يكون الملفان في نفس الــ Folder 3- تغيير اسماء الضفحات الى Page2 Page1 ..... بدل 1/2/3/4 الكود Sub Get_From_Other_WB() Dim mPath$ Dim F_Name, TS$, m% Dim arr(), itm arr = Array("Page1", "Page2", "Page3", "Page4") m = 4 If UCase(ActiveSheet.Name) <> "TOTAL" Then GoTo BAY_BAY_YA_HILWEEN With Sheets("TOTAL") .Cells(4, "D").Resize(UBound(arr) + 1).ClearContents mPath = ThisWorkbook.Path & "\" For Each itm In arr F_Name = mPath & "[Main.xlsx]" F_Name = "='" & F_Name & itm & "'!B2" .Cells(m, "D").Formula = F_Name m = m + 1 F_Name = "" Next .Cells(4, "D").Resize(UBound(arr) + 1).Value = _ .Cells(4, "D").Resize(UBound(arr) + 1).Value End With BAY_BAY_YA_HILWEEN: End Sub الملفان مرفقان ضمن هذا الـــ Folder ALl_SUM.xlsm Main.xlsx

طبعا لن تستطيع التعديل من خلال النموذج لأن مصدر بياناته الاستعلام والاستعلام هذا كافة حقوله محسوبة ومبنية على ثلاث حقول x1 x2 x3 والحل ان تستخدم للتعديل نموذجا خاصا مرتبطا بالجدول بمعنى ان التعديل سيكون على البيانات الأصلية الموجودة في الجدول فقط

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

السلام عليكم أستاذ elhadi_39 تم التعديل وأرجو أن يكون هو المطلوب مجموع المبلغ المحصل في التقرير.accdb

تفضل بعد التعديل القباضة.accdb

أ.elhadi_39 فى تذييل التقرير اعمل مربع نص واكتب فى عنصر التحكم له ما يلى =Sum(Nz([المبلغ])) عسي ان يكون المطلوب

تم عمل المطلوب Option Explicit Sub Hide_unhide() Dim Sh1 As Worksheet, Sh2 As Worksheet Dim Ar_cel, Ar_n, i% Application.ScreenUpdating = False Set Sh1 = Sheets("Sheet1"): Set Sh2 = Sheets("Sheet2") Sh1.Range("D1:Q1").EntireColumn.Hidden = False Ar_cel = Array("B", "E", "H", "J", "N") Ar_n = Array("E", "H", "k", "N", "Q") For i = LBound(Ar_cel) To UBound(Ar_cel) Sh1.Range(Ar_n(i) & 1).EntireColumn.Hidden = _ IIf(Sh2.Cells(7, Ar_cel(i)) = 0, -1, 0) Next i Application.ScreenUpdating = True End Sub '+++++++++++++++++++++++++++++++++++++++++ Private Sub Worksheet_Activate() Hide_unhide End Sub Auto_Jack.xlsm

وعليكم السلام 🙂 تم حذف هذه الميزة من اكسس 2013 ، ولكن هناك اداة من مايكروسوفت لتقوم بنفس العمل اسمها SSMA ، ويمكنك انزالها من هذا الرابط : https://www.microsoft.com/en-us/download/confirmation.aspx?id=54255 جعفر

السلام عليكم ورحمة الله وبركاته =Translate(A4,"ar","en") names.xlsm translate.xlsm

وعليكم السلام-لابد وان تكون المعادلة هكذا ="@"&INDEX(SheetNames,ROW()-1) ومن ثم فعليك إضافة هذه العلامة @ لكل أسماء صفحات الملف حتى تعمل معادلة Indirect بكفاءة

تحديث تم تعديل المعادلة على النحو التالي "2011 : SAR "#,##0.0,_);(#,##0.0,) واصبحت تظهر العملة باليسار بالريال السعودي هل كذا تمام تحياتي

أعتذر أخى على التأخر تفضل لك ماتريد تجربة 1.xls

ستيف الله يرحمه صنع برنامج الوحيد بالعالم يلي يقدر يحول جميع صيغ قواعد البيانات يلي في بالك وطلبه بيل غيتس منه بحكم الصداقة العميقة واثناء ذهاب ستيف لبيل مع البرنامج على cd تعرض ستيف الى حادث وتحطم ال cd وتوفي ستيف في ذلك الحادث وحزن بيل حزناً شديداً وبكى بكاءاً عميقاً وحزن الجميع وتسائلوا عن مصير هذا البرنامج السحري الذي لم يرى النور ولم يجدوا الجواب الشافي لحد الان الى ان سألت حضرتك هذا السؤال واجبتك الجواب الشافي الذي ينتظره الجميع هههههه تحياتي