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

السلام عليكم.. في الحقيقة أن ربط قاعدة البيانات الخلفية بالأمامية إنما هو لوصل البيانات بالنماذج والتقارير! عند استخدامنا لمعالج تقسيم البيانات أو معالج الربط فإن أكسس يقوم بإنشاء جداول نظام يخزن بها البيانات المتعلقة بربط البيانات ومصدرها وآلية ربطها.. الصورة التالية تبين مصدر البيانات وآلية الربط.. نلاحظ في السجل المحدد كيف قام المعالج بتعريف مصدر البيانات المتعلقة بجداول أكسس.. أرجو أن يكون بمقدوركم فهم العلاقة بين مصدر البيانات ومسميات الجداول في المصدر وقاعدة البيانات الأمامية.. لعمل الربط غير المباشر للبيانات عن طريق الشفرة بجداول بيانات أكسس نحتاج إلى الشفرة التالية.. نضع الشفرة التالية في وحدة نمطية عامة Public Function APP_PATH() As String APP_PATH = CurrentProject.Path End Function Public Function DBDAO() As DAO.Database Set DBDAO = OpenDatabase(APP_PATH & "\DB1.ACCDB", False, False, ";PWD=''")'ضع كلمة المررور إذا كانت مطلوبة End Function نضع الشفرة التالية في حدث عند الفتح في النموذج Set Me.Recordset = DBDAO.OpenRecordset("EMPLOYEES", dbOpenDynaset)

السلام عليكم 🙂 كنت ناوي افرد موضوع خاص لهذا الموضوع ، ولكنك ما شاء الله اخوي ابو ابراهيم ابدعت فيه ، فخليني اساهم هنا 🙂 بالاضافة طريقة اخوي ابو ابراهيم ، اليك طريقه انت متعود عليها : 1. هذا مسار قاعدة بيانات الجداول (هذه خطوة مؤقته) ( D:\Documents\Downloads\LINKED DATA\DB1.ACCDB ) : . 2. نعمل استعلام عادي في برنامج الواجهة ، وبدون اختيار اي جداول ، ثم نضع في Source Databasse ، اسم ومسار قاعدة بيانات الجداول (انظر اعلاه) (بدلا عن كلمة Current) : . 3. انقر على زر Show Tables (رقم 2) ، فسترى جداول قاعدة بيانات الجداول : . 4. ونعمل الاستعلام بطريقة عادية ، ونحفظه (كذلك مؤقتا على نعمل النموذج فقط) : . 5. اعمل النموذج المطلوب ، بحيث يكون الاستعلام اعلاه مصدر بياناته: . 6. ثم نحول الاستعلام الى وضع SQL . 7. ونحصل على الجملة التالية : . 8. ثم نضع هذه الجملة في السطر الذي وضعه اخوي ابو ابراهيم ، في حدث التحميل للنموذج (الجملة كما هي من الاستعلام وبتعديل بسيط) : . 9. نحذف الاستعلام مصدر البيانات ، ونحذف اسم الاستعلام من Record Source (مصدر بيانات) النموذج . 10. وكتعديل اخير حتى يشير الى وجدود قاعدة بيانات الجداول في نفس مجلد برنامج الواجهة (حتى يعمل البرنامج على كل جهاز وبأي مجلد) : . جعفر LINKED DATA_2.zip

السلام عليكم ورحمة الله وبركاته فيديو شرح احتراف تصميم يومية الحضور والانصراف بدالتى Weekday, CHOOSE واستخراج اسم اليوم من التاريخ تلقائيا وعمل فورمات لخلية محددة حسب تعبئة محددة ملف العمل.xlsx

تغيير اسماء الصفحات الى الأجنبية لحسن عمل الكود و نسخه Option Explicit Dim i%, Lr% Dim T As Worksheet Dim Spes_sh As Worksheet Dim Flter_rg As Range '+++++++++++++++++++++++++++ Sub ADD_Sheets() Set T = Sheets("Tarhil") Lr = T.Cells(Rows.Count, 2).End(3).Row If Lr < 2 Then Exit Sub With T For i = 2 To Lr If Not Application.Evaluate("ISREF('" & _ .Range("B" & i) & "'!A1)") Then Sheets.Add(, Sheets(Sheets.Count)).Name = _ .Range("B" & i) End If Next End With End Sub '+++++++++++++++++++++++++++ Sub transfer_data() Application.ScreenUpdating = False ADD_Sheets If Lr < 2 Then Exit Sub Set Flter_rg = T.Range("A1").CurrentRegion For Each Spes_sh In Sheets If Spes_sh.Name = T.Name Or Spes_sh.Name = "Justify" Then Else Spes_sh.Range("A1").CurrentRegion.ClearContents Flter_rg.AutoFilter 2, Spes_sh.Name Flter_rg.SpecialCells(12).Copy Spes_sh.Range("A1").PasteSpecial (12) End If Next If T.AutoFilterMode Then T.Range("A1").AutoFilter T.Select With Application .ScreenUpdating = True .CutCopyMode = False End With End Sub الملف مرفق OM_HAMZA_SHEETS.xlsm

واياكم ان شاء الله احسنت القول والتعبير فلا يكون بعيدا عن استاذ فاضل مثل حضرتك كل الاحترام والتقدير

السلام عليكم ورحمة الله وبركاته اتمنى ان شاء الله أن افيد هذا الصرح المبارك كما افادني كثير ♥ https://youtu.be/5sTIMR0MVc0 ملف العمل.xlsx

بارك الله فيك وزادك الله من فضله

مشاركة مع الاساتذة الكبار لا تستهين بان طالب مبتدأ مثلى دخل وعنده الحل ارجو من حضراتكم التركيز فيما اقول لعل وعسى يضغ سره فى اضعف حلقه لقد انحنى ظهرى من الجلوس امام هذه المشكلة والدخول على المواقع الاجنبية مشكلة تعارض الكتابة تأتى عندما يكون هناك نموذج فرعى مصدره استعلام فاكسس يعتبر الاستعلام مفتوح وعند التعديل عليه يعتبر مستخدم اخر دخل والحل عند الضغط على الزر الموجود لديكم لتعديل حقل الرقم قم بالتالى : اجعل مصدر النموذج الفرعى فارغ غير الاستعلام المرغوب فيه باستخدام الكود التالى اسم النموذج الفرعى.RecordSource="" ثم السطر الذى يلى هذا الكود مباشرا اجعل مصدر النموذج الاستعلام المرغوب فيه me.RecordSource="query" وطالما ان قاعدة البيانات متصلة بـ sql فلا فائدة بان تجعل تأمين السجل : سجل محرر ولكن افعلها لعل وعسى جزاكم الله خيرا

جرب التالي ، كل خطوة مستقلة عن الاخرى ، اعمل كل واحدة بطريقة مستقلة ، ثم مافي مانع تجمعهم مع يعض : 1. اوقف الـ Recordset وشوف اذا تأتيك الرسالة ، 2. بعد ان تعمل تحديث او تغيير في الـ Recordset ، مباشرة الخطوة التالية احفظ السجل : DoCmd.RunCommand acCmdSaveRecord ، 3. بعد ان تعمل العملية الحسابية ، مباشرة الخطوة التالية احفظ السجل : DoCmd.RunCommand acCmdSaveRecord جعفر

هل استعلام ثم تستعمل Recordset يستعمل الاستعلام ؟ اذا كان هناك كود / طريقة معينة دائما تحصل بها على الخطأ ، فجرب هذا الكود وشوف اذا تحصل به على خطأ : Me.EnzarKbl = Me.EnzarKbl جعفر

السلام عليكم 🙂 رسالة Write Conflict: الرسالة هذه معناها ، انه في النموذج في أكثر من جهة تدخل البيانات منذ فتحه ، والبرنامج محتار ، هل يأخذ بيانات الادخال من النموذج مباشرة ، او من البيانات اللى جاته من الاستعلام (او قد تأتيه من الجدول ، اذا عملت تحديث للبيانات للجدول ، وتنعكس هذه البيانات على النموذج) ، وبالاخص عند تغيير البيانات عن طريق Recordset . والرابط التالي فيه كود ، ولكن تابع الكود وسترى اني كنت محتاج اجدد/احدّث معلومات النموذج ، ولكن صادفتني هذه الرساله ، فاضطررت ان استعمل كود وطريقة ثانية لحل الموضوع: http://www.officena.net/ib/topic/65548-المساعدة-في-جمع-الدقائق-حسب-الشهر-للموظف/#comment-426706 جعفر

السلام عليكم 🙂 تعديل اخير سيساعدك في معرفة : 1. اي يوم من ايام الاسبوع هذا التاريخ ، 2. عند الاختيار من الشفت في النموذج الفرعي اعلاه ، تلقائيا يتغير لون الحقل في التقرير الاسفل ، الى اللون الاحمر الفاتح ، حتى تميز وتركز على هذا الحقل 🙂 . جعفر 1281.5.FRm_Refresh.accdb.zip

استخدم هذا الكود قبل تشغيل الاستعلام DoCmd.RunCommand acCmdSaveRecord

كلام حضرتك صح صح بس الطريقة معقدة بعض الشئ على طلاب العلم المبتدئين امثالى المرفق الاتى فيه 3 قواعد 1- القاعدة الخلفية: الجداول ---------------------------------------------- TablesArchivingDB.accdb 2-القاعدة الامامية: النماذج وباقى الكائنات --------------------------------------------Archiving.accdb 3- قاعدة تشغيل التطبيق ------------------------------------------------------------Run My App.mde تم اضافة بعض التعديلات لتأمين القاعدتين القاعدة الخلفية / القاعدة الامامية بعدم تمكين زر الشيفت لهما وبهذه الطريفة الان والله اعلم 1- يصعب تمكين الشيفت 2- يصعب استيراد الكائنات من اى منهما 3- يصعب الوصول الى جدول النظام MSysObjects لاستخراج بيانات الاتصال بقاعدة الجدول اترككم مع التجربة الحماية 2.rar

زادكم الله رفعة وعلما

السلام عليكم ونداوز عربي أوفيس عربي النتيجة مع الفاصلة المنقوطة صحيحة في جميع حالات لوحة المفاتيح النتيجة مع الفاصلة غير صحيحة في جميع حالات لوحة المفاتيح تعطي سطر واحد

طبعا تنشىء الاستعلام في قاعدة البيانات الخلفية.. ثم تشير إلى الاستعلام باسمه كما في الجدول.. إذا كنت تريد عمل استعلام يشير إلى محددات من قيم في حقول النموذج فيمكنك إنشاء جملة الاستعلام مكان اسم الجدول.. Set Me.Recordset=DBDAO.OpenRecordset("SELECT * FROM CUSTOMERS WHERE [CUSTOMER ID]=" & Me.CB_CUSTOMER_ID) في الحالة هذه تستطيع وضع جملة الاستعلام في حدث After_Update للحقل.. أو تعيد تنشيط النموذج باستخدام Me.Requery في نفس الحدث

النظام عندي: الوندوز والاوفيس انجليزي ، و جربت كودك ، بالفاصلة والفاصلة المنقوطة ، والكيبورد باللغة الانجليزية ، والنتيجة كانت صحيحة في كل الحالتين ، ونحصل على قائمة بعدة اسطر بأسماء الكائنات 🙂 cmd_close,cmd_Requery,cmd_Add_New,cmd_Add_New_Between_Dates,cmd_Copy_Between_days cmd_close,cmd_Requery;cmd_Add_New;cmd_Add_New_Between_Dates:cmd_Copy_Between_days اما استعمال الفاصل والفاصلة المنقوطة ، والكيبورد باللغة العربية ، فالنتيجة كانت غير صحيحة في كل الحالتين ، ونحصل على قائمة الكائنات في سطر واحد مثل ماهو ادناه : cmd_close،cmd_Requery،cmd_Add_New،cmd_Add_New_Between_Dates،cmd_Copy_Between_days cmd_close؛cmd_Requery؛cmd_Add_New؛cmd_Add_New_Between_Dates؛cmd_Copy_Between_days . ولكن لا عرف النتيجة عند تجربة هذا الكود في وندوز عربي واوفيس عربي !! جعفر

السلام عليكم ورحمة الله وبركاته بالنسبة لي استخدم الكود التالي : Select Case KeyCode Case 70 And Shift = 2 '========ÇáÛÇÁ ÇÎÊÕÇÑ ctrl+f=========== KeyCode = 0 Case 72 And Shift = 2 '========ÇáÛÇÁ ÇÎÊÕÇÑ ctrl+h========== KeyCode = 0 End Select

اولا هى دالة من دوال الاكسل وليس الاكسس ولكن ممكن تحقيقها برمجيا لتناسب الاكسس من خلال الاكواد والمرفق يوضح ذلك الشــــــــــــرح الوصف تُرجع رقماً تم تقريبه للأعلى، بعيداً عن الصفر، إلى أقرب مضاعف للوسيطة significance. على سبيل المثال، إذا كنت تريد تجنب استخدام السنت في الأسعار وكان سعر المنتج 4,42 ر.س.، فاستخدم الصيغة ‎=CEILING(4,42,0,05)‎ لتقريب السعر للأعلى إلى أقرب مبلغ صحيح. بناء الجملة CEILING(number, significance)‎ يحتوي بناء جملة الدالة CEILING على الوسيطتين التاليتين: Number مطلوبة. وهي القيمة التي تريد تقريبها. Significance مطلوبة. وهي المضاعف الذي تريد التقريب إليه. ملاحظات إذا كانت قيمة أي الوسيطتين غير رقمية، فستُرجع الدالة CEILING قيمة الخطأ ‎#VALUE!‎. يتم تقريب القيمة للأعلى عند تعديلها بعيداً عن الصفر، وذلك بغض النظر عن علامة الوسيطة number. أما إذا كانت number عبارة عن مضاعف صحيح للوسيطة significance، فلن يحدث أي تقريب. إذا كانت قيمة الوسيطتين number وsignificance سالبتين، فيتم تقريب القيمة للأدنى، بعيداً عن الصفر. إذا كانت قيمة number سالبة وكانت قيمة significance موجبة، فيتم تقريب القيمة للأعلى باتجاه الصفر. مثال انسخ البيانات النموذج في الجدول التالي، والصقها في الخلية A1 في ورقة عمل Excel جديدة. لعرض نتائج الصيغ، حدد هذه الأخيرة، ثم اضغط على F2، ثم اضغط على Enter. عند الحاجة، يمكنك ضبط عرض العمود لرؤية البيانات كافة. الصيغة الوصف ‎=CEILING(2.5, 1)‎ تقريب 2,5 للأعلى إلى أقرب مضاعف لـ 1 3 ‎=CEILING(-2.5, -2)‎ تقريب ‎-2,5 للأعلى إلى أقرب مضاعف لـ ‎-2 ‎-4 ‎=CEILING(-2.5, 2)‎ تقريب ‎-2.5 للأعلى إلى أقرب مضاعف لـ ‎-2 ‎-2 ‎=CEILING(1.5, 0.1)‎ تقريب 1,5 إلى أقرب مضاعف من لـ 0,1 1,5 ‎=CEILING(0.234, 0.01)‎ تقريب 0,234 إلى أقرب مضاعف من لـ 0,01 0,24 امثلة Ceiling(2.5, 1) equals 3 Ceiling(2.5) equals 3 Ceiling(-2.5, -2) equals -4 Ceiling(-2.5, 2) equals -2 Ceiling(1.5, 0.1) equals 1.5 Ceiling(0.234, 0.01) equals 0.24 Ceiling function.mdb

تمام الله ينور عليك اخي انا حولت ومعرفتش اصل للجداول 😁

شكرا جدا مشرفنا سليم تم حل المشكلة بفضل مناقشتك

اضافة لما اشار الية الاستاذ @husamwahab يمكن استخدام كود الرقم مباشرة للالوان ..........BackColor = 16250095 اود ان اضيف بعض الادوات المساندة لاختيار الالوان لقاعدة البيانات هذه الصفحة تحتوي على مجموعة كبيرة من الالوان بثلاث صيغة تعمل مع اكسس اداة صغيرة لمعرفة كود اللون لاي موقع او برنامج قاعدة بيانات لتحويل كود اللون لصيغة الوان اكسس الرقمية او صيغة Hex او R G B الملف في المرفقات Colors.rar

لا تفتج اي شيت لان ActiveSheet يفتجة اوتومانيكياً

اضف هذه العبارة داخل المربع الأزرق كي نغرف في اي شيب ينم العمل MsgBox ActiveSheet.Name

هو كذلك اذا لم يكن هنالك اخطاء اخرى في حال ظهور اخطاء اقفل الملف دون Save

قم بهذه التجربة استبدال ما في المربع الأحمر بما في المربع الأزرق اينما تجدها( داخل كل الأكواد) كما في الصورة

صديقى تم الرد على سؤالك بالاجابة اته لا يمكن لأحد ان يضع لك 50 كود لاكثر من 50 تكست بوكس لو كل كود اخذ 10 دقائق لوضعه (كي لا اقول أكثر) المسألة يلزمها 8 ساعات

جميل تمام التمام تسلم ايدك انقذتنى ربنا ينجيك دائماااااااااااااااااااااااااااا ربنا يحفظك ويفرحك ويسترك ويكرمك الف الف شكر ربنا يجعل كل ايامك هنا وسرور وسعادة وازهار وكل حاجة جميلة انا مش عارفة اشكرك ازى والله ربنا يعزك ما اتحرمش منك ابداااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااا يارب اللهم امين

صممت لك كود لأخضر والأحمر R_G (على اساس انه اخر سؤال) من أين اتى R_B ؟؟؟ ( لماذا اختلفت المعادلات عما ورد في الرسالة على الحاص؟؟) الكود للـــ R_G يمكنك تعديل المعادلات داخله كما نريدين (و سوف أغلق الموضوع لأنه اخذ اكثر يكثير من وقته) Option Explicit Sub get_By_Color() Dim D As Worksheet Dim Sh As Worksheet Dim Ar(), Min_date As Date, Max_date As Date Dim K%, t%, Arr_sh() Dim My_ro%, m%, ro%, my_sum#, x% Dim Sum_pos#, Sum_Neg# Dim Part_sum# K = 2 Set D = Sheets("DataReport") D.Rows.Hidden = False If D.Range("A3").CurrentRegion.Rows.Count > 1 Then D.Range("A3").CurrentRegion.Offset(1). _ Resize(D.Range("A3").CurrentRegion.Rows.Count - 1).Clear End If If Not IsDate(D.Range("J2")) Or _ Not IsDate(D.Range("K2")) Then Exit Sub Min_date = Application.Min(D.Range("J2:K2")) Max_date = Application.Max(D.Range("J2:K2")) Ar = Array("E", "F", "G", "H", "I", "J") 'For Each Sh In Sheets Select Case UCase(D.Range("N1")) Case 3, 10, 55 For Each Sh In Sheets If Sh.Tab.ColorIndex = D.Range("N1") Then ReDim Preserve Arr_sh(m) Arr_sh(m) = Sh.Name: m = m + 1 End If Next Case "R_B" For Each Sh In Sheets If Sh.Tab.ColorIndex = 3 _ Or Sh.Tab.ColorIndex = 55 Then ReDim Preserve Arr_sh(m) Arr_sh(m) = Sh.Name: m = m + 1 End If Next Case "R_G" For Each Sh In Sheets If Sh.Tab.ColorIndex = 3 _ Or Sh.Tab.ColorIndex = 10 Then ReDim Preserve Arr_sh(m) Arr_sh(m) = Sh.Name: m = m + 1 End If Next Case "G_B" For Each Sh In Sheets If Sh.Tab.ColorIndex = 10 _ Or Sh.Tab.ColorIndex = 55 Then ReDim Preserve Arr_sh(m) Arr_sh(m) = Sh.Name: m = m + 1 End If Next Case Else For Each Sh In Sheets If Sh.Tab.ColorIndex = 3 _ Or Sh.Tab.ColorIndex = 10 _ Or Sh.Tab.ColorIndex = 55 Then ReDim Preserve Arr_sh(m) Arr_sh(m) = Sh.Name: m = m + 1 End If Next End Select If m = 0 Then Exit Sub For m = LBound(Arr_sh) To UBound(Arr_sh) D.Cells(K, 1) = Arr_sh(m) D.Cells(K + 1, 1) = "Total " & D.Cells(12, "J") D.Cells(K + 1, 1).Resize(, UBound(Ar) + 2).Interior.ColorIndex = 20 K = K + 2 Next m My_ro = 3 For m = LBound(Arr_sh) To UBound(Arr_sh) Set Sh = Sheets(Arr_sh(m)) Sh.Range("A5:J20000").Interior.ColorIndex = xlNone ro = Sh.Cells(Rows.Count, 1).End(3).Row For K = LBound(Ar) To UBound(Ar) t = K + 2 For x = 5 To ro If Sh.Cells(x, 1) <= Max_date _ And Sh.Cells(x, 1) >= Min_date Then Sh.Cells(x, 1).Interior.ColorIndex = 40 If Val(Sh.Cells(x, Ar(K))) <> 0 Then my_sum = my_sum + Sh.Cells(x, Ar(K)) '+++++++++++++++++++++++++++++ If Val(Sh.Cells(x, Ar(K))) <= 0 Then Sum_Neg = Sum_Neg + Val(Sh.Cells(x, Ar(K))) Sh.Cells(x, Ar(K)).Interior.ColorIndex = 6 Else Sum_pos = Sum_pos + Val(Sh.Cells(x, Ar(K))) Sh.Cells(x, Ar(K)).Interior.ColorIndex = 35 End If '++++++++++++++++++++++++++ Part_sum = Round((Sum_pos * 0.85) + Sum_Neg, 2) End If '<>0 End If Next x '////////////////////////////// Select Case D.Cells(12, "J") Case "Positive" Select Case D.Range("N1") Case 3: Sum_pos = 0.1475 * Sum_pos Case 55: Sum_pos = 0.705 * Sum_pos '}}}}}}}}}}}}}}}}}}}}} Case "R_G" If Sh.Tab.ColorIndex = 3 Then Sum_pos = 0.1475 * Sum_pos ElseIf Sh.Tab.ColorIndex = 10 Then Sum_pos = 0.705 * Sum_pos Else Sum_pos = Sum_pos End If '}}}}}}}}}}}}}}}}}}}}} Case Else: Sum_pos = Sum_pos End Select D.Cells(My_ro, t) = Sum_pos Case "Nagative" D.Cells(My_ro, t) = Sum_Neg Case "Part" D.Cells(My_ro, t) = Part_sum Case Else D.Cells(My_ro, t) = my_sum End Select '////////////////////////////// my_sum = 0: Sum_pos = 0: Sum_Neg = 0: Part_sum = 0 Next K My_ro = My_ro + 2 Next m D.Cells(My_ro, 1) = "Sum Of All" Rem D.Cells(My_ro - 1, 2).Resize(, UBound(Ar) + 1) = Ar With D.Cells(My_ro - 1, 2).Resize(, 6) .Value = D.Cells(1, 2).Resize(, 6).Value .Interior.Color = vbBlue .Font.Color = vbWhite End With D.Cells(My_ro, 2).Resize(, UBound(Ar) + 1).Formula = _ "=Sum(B3:B" & My_ro - 2 & ")" D.Cells(My_ro, 1).Resize(, UBound(Ar) + 2).Interior.ColorIndex = 6 If D.Range("A3").CurrentRegion.Rows.Count > 1 Then With D.Range("A3").CurrentRegion.Offset(1). _ Resize(D.Range("A3").CurrentRegion.Rows.Count - 1) .Borders.LineStyle = 1: .Font.Size = 14 .Font.Bold = True: .HorizontalAlignment = xlCenter .Value = .Value End With End If For m = My_ro - 2 To 3 Step -1 If D.Cells(m, 1) Like "Total*" And _ Application.Sum(D.Cells(m, 2).Resize(, 6)) = 0 Then D.Range(Cells(m, 1), Cells(m - 1, 1)).EntireRow.Hidden = True End If Next End Sub الصورة تظهر مكان التعدبل والملف مرفق (تم ازالة الزركشات بالألوان لتحجيم الملف الى 2.5 ميغا و مازال كبيراً ) Yara_super_More_Optione.xlsm

وحتى تعم الفائدة المرفق النهائى بعد التعديلات الصحيحة Autolink Table.zip

بالموضوع تجد حماية جميع الكائنات وبمافيها الجداول المرتبطه والمضمنة ::بالتوفيق::

هذه المعادلة تحدد لك القيمة الممكن اضافتها حسب شروطك =CEILING(A1/100;10) ممكن تضيف لها الرقم الاصلي لو حبيت بالتوفيق

تم اضافة معادلة عن طريق vba =ReverseTxt(B2) استخدم المعادلة في الملف المرفق وبالتوفي ق نص معكوس.xlsm

جزاكم الله خيرا اخوانى واساتذتى @صالح حمادي @jjafferr @husamwahab 💐 وشرح وتوضيح اكثر من رائع معلمنا العزيز جعفر بارك الله فيك وبارك لك فى كل ما تحب بالتوفيق اخوانى

husamwahab بجد تسلم والله الله ينور عليك يا استاذنا الف الف شكر

بالخدمة استاذ AhmedEmam بالنسبة للالوان ضع الكود التالي بدل كود خلفية النموذج Forms(str).FormHeader.BackColor = vbRed Forms(str).Detail.BackColor = vbBlue Forms(str).FormFooter.BackColor = vbGreen

السلام عليكم 🙂 تفضل 🙂 . واستعمل الاستعلام qry_Group_Shifts_by_Dates كمصدر بيانات ، وتقدر تعمل به التقرير او النموذج الذي تشاء. جعفر 1281.4.FRm_Refresh.accdb.zip

السلام عليكم مشاركة مع اساتذتي الاعزاء تفضل هذه المحاولة ارجو ان تكون طلبك ملاحظة : شغل المايكرو لتشغيل الكود وهو معد لتغيير خلفية جميع النماذج المفردة في قاعدة البيانات BackGround.rar

1-ليس من الضرورة رفع ملف يجتوي على اكثر من 1500 صف لان الماكرو الذي يعمل على صف واحد بستطيع العمل على الوف الصفوف 2- تم اختصار الملف الى حوالي 80 صف لمتابعة عمل الماكرو 3-الكود Option Explicit Dim sh As Worksheet Dim New_sh As Worksheet Dim lr%, Cont#, i%, x%, k% Dim SectionName As Range Const How_Many = 20 '+++++++++++++++++++++++++++++++ Sub Del_sheets() Application.DisplayAlerts = False For Each sh In Sheets If sh.Name Like "Section*" Then sh.Delete End If Next Main.Select Application.DisplayAlerts = True End Sub '++++++++++++++++++++++++++++++ Sub insert_Sheets() Del_sheets Set SectionName = Main.Range("D3:K3") lr = Main.Cells(Rows.Count, 3).End(3).Row Cont = (lr - 1) / How_Many If Int(Cont) <> Cont Then Cont = Cont + 1 End If Cont = Int(Cont) For i = 1 To Cont Sheets.Add(, Sheets(Sheets.Count)).Name = "Section_" & k * How_Many + 1 k = k + 1 SectionName.Copy With ActiveSheet.Range("D3") .PasteSpecial (xlPasteAll) .PasteSpecial (8) End With Next Application.CutCopyMode = False Main.Select End Sub '++++++++++++++++++++++++++++++++++++ Sub fil_data() Application.ScreenUpdating = False insert_Sheets x = 4 For Each New_sh In Sheets If New_sh.Name Like "Section*" Then Main.Range("D" & x).Resize(How_Many, 9).Copy New_sh.Range("D4").PasteSpecial (xlPasteAll) New_sh.Range("D4").PasteSpecial (8) x = x + How_Many End If Next Application.ScreenUpdating = True Main.Select End Sub 4-الملف مرفق Taksim_Ahmad.xlsm

بالنسبة لهذين السطرين يعملان معي جرب وضع السطر الاول في بداية كود الترحيل sheet1.Unprotect pwd اما السطر الثاني في نهاية كود الترحيل sheet1.Protect pwd مع مراعاة اسم الورقة

دائماً وأبداً ممنوع دمج الخلايا حيث توجد معادلات (الصفوف 7/ 8 / 9) Yaser_W.xlsm

السلام عليكم ورحمة الله وبركاته 📜برنامج المخزون والفواتير الشامل الإصدار الرابع 2020 البرنامج هو تحديث للاصدارات السابقة من نفس البرنامج اولا وقبل كل شيئ اعتذر عن التأخير فى اطلاق هذا الاصدار نظرا لانشغالي الدائم وظروف خارجه عن الارادة. كما هو معروف عن برنامج المخزون و الفواتير الشامل: واجهة تطبيقية كاملة علي الاكسيل يصلح لكافة اغراض المبيعات و المشتريات وذمم عملاء وموردين و حساب المصروفات مع ميزانية عامه توضح الربح و الخساره. البرنامج مليئ بافكار جديده فى طريقة ادخال الاصناف داخل الفواتير و استدعائها و التعديل عليها.بالاضافه الي طرق جديده فى تصميم الفاتورة كما يتميز البرنامج بكثرة التقارير وسهولة الحصول عليها فى اى وقت يعمل علي جميع اصدارات الاكسيل بنواتين 32 أو 64 بت ويفضل دائما الاصدارات الاحدث من الاكسيل اوفيس 2019 و 365 البرنامج مجاني بنسبة 100 % للاستخدام الشخصي ولا يوجد به تاريخ انتهاء. وتستطيع استخدامه بامان تام.ويمنع بيع البرنامج او اي ربح تجاري بدون الرجوع الي المالك الاصلي.و الله الشاهد علي ذلك. تم تصميم البرنامج بمواصفات خاصه ويعمل للشركات الصغيره الي متوسطة الحجم او للمشاريع الخاصه .وهو فى الاصل برنامج تجارى ولكنى اقدمه هنا للمنتدى وللأخوة الاعضاء بصورة مجانية. تم اطلاق الاصدار الاول من هذا البرنامج عام 2012.وكل ما يلزم هو وجود نسخة اكسيل علي جهازك.وسيفي بالغرض تماما. هذا هو اخر اصدار للبرنامج علي اكسيل و الاصدار الخامس و لمزيد من التحسينات الكبيره سوف يتم تطويره إن شاء الله بلغة برمجه اخري وقاعده بيانات اخري. الدخول الاول:اسم المستخدم "مدير" و الباسورد 123 تم ارفاق نسختين من البرنامج نسخة الاستخدام المباشر كمستخدم ويمكنك استخدامها فى عملك مباشرة. نسخة اخري للتعلم مفتوحة المصدر وتوجد بها جميع الاكواد لجميع الشاشات داخل البرنامج للتعلم او التعديل عليها كما هو الغرض الرئيسي من هذا الصرح العظيم. يمكنك الرجوع الي الاصدارات السابقة حيث يوجد شرح كامل لكيفية استخدام البرنامج لاول مرة. توجد الروابط للاصدارات السابقة و الشرح اسفل هذا الموضوع . 📑الجديد في هذا الاصدار (2020)SIS Ver.4: شاشة تصميم الفواتير و هي من الشاشات الجديدة وبها الكثير من الاكواد الجديده فى الاكسيل (علي حسب علمي) حيث تمكنك من وضع اللوجو الخاص بالمؤسسه او الشركة الخاصه بك كما يمكنك ايضا وضع بياناتك اسفل الفاتورة كرقم التليقون و العنوان و ...... التحكم الكامل في بعض القيم و ظهورها داخل الفاتورة كرصيد العميل. شاشة اختيار عملة الدولة ووضع الضريبه او القيمه المضافه تمكنك هذه الشاشه من اختيار العمله علي حسب الدوله التي تعمل فيها. كما تمكنك من ضبط قيمة الضريبه او القيمه المضافه لفواتيرك شاشة ضبط صلاحيات المستخدمين بعد اضافة مستخدم جديد للبرنامج تستطيع ضبط صلاحيات المستخدم من الوصول الي جميع شاشات البرنامج شاشة حذف البيانات الغير مستخدمة بكل سهولة تستطيع حذف العملاء و الموردين او الاصناف الغير مستخدمة داخل البرنامج. شاشة الحركة المالية السريعة تستطيع ادخال سند صرف موردين او سند عميل بضغطة زر واحده. شاشة الفواتير الكثير من التحسينات تم ادارجها داخل شاشة الفواتير فاتورة المشتريات . انت من يقوم بوضع رقم الفاتورة الخاصه من المورد.بدلا من وضعها اتوماتيكيا كالاصدار السابق. اضافة خصم اجمالي علي الفاتورة. يتم تحديد الخصم كنسبه مئويه او خصم مبلغ مقطوع. اضافة الضريبه علي الفاتورة ويمكن تحديد قيمتها يدويا او تثبيتها من خلال شاشة البيانات الجديده وضبط الضريبه او القيمه المضافه علي حسب الدولة. مبيعات نقدي: فى حالة اختيار هذا النوع من الفواتير يتم ادراج سند قبض مباشره الي حساب العميل مع حفظ الفاتورة لانها مبيعات نقدية. ظهور رصيد العميل الحالي داخل الفاتورة. و التحكم في ظهوره من خلال شاشة تصميم الفاتورة. زر لسداد كامل الفاتورة مباشرة وادراج سند قبض او سند صرف داخل حساب العميل/المورد سند بالمبلغ المدفوع داخل الفاتورة وتسوية حساب العميل او المورد. شاشة الحركات المالية ادراج الكثير من الحركات المالية داخل سند الصرف. شاشة جديده لحساب رواتب وجميع الحسابات للموظفين العاملين فى المؤسسة او الشركة يوجد الكثير من الاضافات و التحسينات علي كل الشاشات والتقارير داخل البرنامج . تستطيع اكتشاف المزيد و المزيد اثناء استخدام البرنامج. التعامل مع رصيد اول المده (كميات الاصناف- حسابات العملاء/الموردين) تم الاستغناء عن شاشة اكواد البيانات والجرد فى هذا الاصدار وكانت تستخدم لوضع رصيد اول المده للاصناف. وعوضا عن ذلك ولحساب المخزون بطريقه منظمه يجب ان يتم وضع كميات اول المده لجميع الاصناف من خلال فاتورة مشتريات باسعار شراء محدده حتي يتم ادراجها وحسابها بطريقه دقيقه.وايضا فى حالة رصيد سابق للعملاء والموردين يجب ان يتم ادخاله من خلال شاشة الحركات الماليه( حركة ماليه رصيد اول مده او ترحيل لحساب عميل/مورد) طباعة الباركود لا تزال غير مفعله ايضا فى هذا الاصدار. 👁️‍🗨️شرح كيفية استخدام البرنامج وادخال البيانات من الاصدارت السابقة:(برجاء مراجعة الروابط التالية) شرح برنامج المخزون و الفواتير الشامل(مشاركة داخل المنتدى) استخدام البرنامج لاول مره من الاصدار الثالث شرح برنامج المخزون و الفواتير الشامل( ملف تنفيذى... 6MB رابط خارجى على موقع ميديا فاير) 🏷️تحميل البرنامج: النسخة الاولي SIS 4.566EO : هى نسخة المستخدم النهائي مجانيه 100 % لاعضاء المنتدي الكرام وليس لها تاريخ انتهاء وكما ذكر سابقا هي للاستخدام الشخصي فقط. 💳SIS 4.566EO.rar النسخة الثانيه SIS 4 Learning : هي نسخة للمطورين و الباحثين عن التعلم وهي نسخة مفتوحة المصدر تحتوي علي جميع اكواد الشاشات داخل البرنامج. 🧼SIS4(Learning).rar إن شاء الله سوف اقوم بالرد علي استفسارات اعضائنا الكرام عندما يتوفر لي الوقت و اعتذر مقدما عن اي تاخير نظرا لانشغالي الدائم. اخيرا أحب انا أشكر جميع مشرفي و اعضاء هذا الصرح العظيم. واتمني من الله ان يكون هذا العمل خالصا لوجه الله سبحانه و تعالي و انا اكون قد قدمت تجربه جيده لهذا النوع من البرامج علي الاكسيل وان ينفع به جميع اعضاء المنتدي الكرام

تم حل المشكلة بفضل الله تعالى اخى الحبيب و استاذى الجليل ومعلمى القدير الاستاذ @أبو عبدالله الحلوانى كان الخطأ فى هذا السطر Set chkDb = OpenDatabase(Application.CurrentProject.Path & "\Btbl.accdb") وتم التعديل على الكود كالاتى ونجحت العملية بفضل الله تعالى Set chkDb = OpenDatabase(Application.CurrentProject.Path & "\Btbl.accdb", False, False, ";PWD=0")