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

اعرض الملف كود توزيع الفصول أوتوماتيكيا السلام عليكم هذا ملف يشتمل على كود يوزع الفصول على حسب الأعدااد التى تحددها لكل صف و يمللأ كمبوبوكس بالنتيجة مساهمة بسيطة فى شهر الصيام الباب مفتوح للتعديل و النقد وفقكم الله يحتاجه من يقومون بوضع الجداول صاحب الملف عبد الفتاح كيرة تمت الاضافه 13 يون, 2017 الاقسام قسم الأكسيس

سيبك من الأجانب دول تفكيرهم تقليدي 1 + 1 = 2 وده طبعا مينفعش معانا لازم تبتكر يعني مثلا 1+1 = 3 - 1 المهم فكرة الدالة على السريع إنها بتشوف القيم المسجلة في المربعات الثلاثة مجتمعة وبناءا على تلك القيم يتم انشاء كود استعلام ثم نجعله مصدر النموذج لذلك لكي تطبق الدالة عليك أولا أن تختار مصدر بيانات النموذج هو الجدول وثانيا تكتب الكود التالي في محرر الفيجوال بيسك وجرب واعمل أكثر من تجربة مرة قيمة خالية هنا ومرة قيمتين خاليتين هناك وهكذا Option Compare Database Dim strSQL, a, b, c As String Private Sub SectionSearch_AfterUpdate() rs End Sub Private Sub StatusSearch_AfterUpdate() rs End Sub Private Sub UserSearch_AfterUpdate() rs End Sub Function rs() strSQL = "" a = strSQL & IIf(Nz(Me.UserSearch, 0) = 0, "", " (Table1.User) Like '*" & "" & Me.UserSearch & "" & "*'") b = strSQL & IIf(Nz(Me.SectionSearch, 0) = 0, "", " (Table1.Section) Like '*" & "" & Me.SectionSearch & "" & "*'") c = strSQL & IIf(Nz(Me.StatusSearch, 0) = 0, "", " (Table1.Status) Like '*" & "" & Me.StatusSearch & "" & "*'") If Nz(Me.UserSearch, 0) = 0 And Nz(Me.SectionSearch, 0) = 0 And Nz(Me.StatusSearch, 0) = 0 Then Me.RecordSource = "SELECT Table1.ID, Table1.User, Table1.Section, Table1.Status FROM Table1; " Else strSQL = "SELECT Table1.ID, Table1.User, Table1.Section, Table1.Status FROM Table1 WHERE " If Nz(Me.UserSearch, 0) <> 0 Then strSQL = strSQL & a If Nz(Me.SectionSearch, 0) <> 0 Then strSQL = strSQL & " and " & b If Nz(Me.StatusSearch, 0) <> 0 Then strSQL = strSQL & " and " & c Else If Nz(Me.StatusSearch, 0) <> 0 Then strSQL = strSQL & " and " & c End If Else If Nz(Me.SectionSearch, 0) <> 0 Then strSQL = strSQL & b If Nz(Me.StatusSearch, 0) <> 0 Then strSQL = strSQL & " and " & c Else If Nz(Me.StatusSearch, 0) <> 0 Then strSQL = strSQL & c End If End If Me.RecordSource = strSQL End If Me.Requery End Function

السلام عليكم أخي الفاضل : إجابة على سؤالك الأول بما يخص إزالة الارتباط أطلع على هذه الصور التوضيحية علها تساعدك على فهم كيفية إزالة الارتباط بعد تنفيذ جميع الخطوات أضغط زر إغلاق لتنهي التعديلات الموضحة في الصور المرفقة أرجو أن أكون قدمت لك إجابة وافية لسؤالك الأول. بالنسبة للسؤال الثاني فإني أدعه لجهابذة العلم في هذا المنتدى فهم الخبراء الذين أتعلم منهم الكثير.

مشاركة مع استاذ @محمدنجار اتفضل اخي اطارق فقط عليك ان تفتح الاستعلام مرة واحدة فقط قبل الفتح انظر الى الجدول حقل sss وبعد تشغيل الاستعلام انظره مرة اخرى والاستعلام سيكون كالتالي UPDATE Table1 SET Table1.sss = [wared]-[mortajaa]; اتفضل اليك القاعدة بها استعلام تحديث عمل حساب واضافته الى الجدول.rar

السلام عليكم ورحمة الله وبركاته اخي @Rebaz Bahram كتير من الاعضاء يخطؤن ويعمل علامة صح امام مشاركته علامة صح هو لجواب الاصح لذا اعمل علامة صح امام جواب الاصح اي امام جواب استاذنا @أبو إبراهيم الغامدي لكي من يزور هذا الموضوع يعرف ما هو الجواب لهذا السؤال ولكي يستفيد منه مع تقدير

هذا الرسالة لمكتبة مرجع مفقودة.. إذهب لمكتبة المراجع وحرر ارتباط المكتبة المفقود فقط.. المكتبة لا علاقة لها بالتعديل. إليك التعديل Linked tables.zip

السلام عليكم هذا الموضوع مكرر و له نفس الإجابة هنا يغلق

جرب التعديل التالي عله يفي بالغرض (ويرجى فيما بعد حين تطرح موضوع أن ترفق الملف الأصلي أو ملف معبر عنه تماماً لكي يسير العمل بشكل منتظم وكما هو مطلوب ومتوقع) Sub Test() Dim arr As Variant Dim arBr As Variant Dim arLu As Variant Dim arDi As Variant Dim i As Long Dim j As Long Dim b As Long Dim l As Long Dim d As Long arr = Range("A116:E" & Cells(Rows.Count, 1).End(xlUp).Row).Value ReDim arBr(1 To UBound(arr, 1), 1 To UBound(arr, 2) - 1) ReDim arLu(1 To UBound(arr, 1), 1 To UBound(arr, 2) - 1) ReDim arDi(1 To UBound(arr, 1), 1 To UBound(arr, 2) - 1) For i = 1 To UBound(arr, 1) If arr(i, 4) = "ص" Then b = b + 1 For j = 1 To 3 arBr(b, j) = arr(i, j) Next j arBr(b, 4) = arBr(b, 2) * arBr(b, 3) ElseIf arr(i, 4) = "غ" Then l = l + 1 For j = 1 To 3 arLu(l, j) = arr(i, j) Next j arLu(l, 4) = arLu(l, 2) * arLu(l, 3) ElseIf arr(i, 4) = "ع" Then d = d + 1 For j = 1 To 3 arDi(d, j) = arr(i, j) Next j arDi(d, 4) = arDi(d, 2) * arDi(d, 3) ElseIf arr(i, 4) = "م" Then l = l + 1 d = d + 1 For j = 1 To 3 arLu(l, j) = arr(i, j) arDi(d, j) = arr(i, j) Next j arLu(l, 2) = Application.WorksheetFunction.Round(arLu(l, 2) * 2 / 3, 2) arDi(d, 2) = Application.WorksheetFunction.Round(arDi(d, 2) * 1 / 3, 2) arLu(l, 4) = arLu(l, 2) * arLu(l, 3) arDi(d, 4) = arDi(d, 2) * arDi(d, 3) End If Next i Range("B15").Resize(b, UBound(arBr, 2)).Value = arBr Range("B24").Resize(l, UBound(arLu, 2)).Value = arLu Range("B65").Resize(d, UBound(arDi, 2)).Value = arDi End Sub

Gamal.Saad أستاذنا يعطيك العافية الكود اشتغل 100% ألف شكر لك. Amr Ashraf فالنفترض أحد المستخدمين ما أدخل بيانات في حقل ما لإنه ما يحتاجها حالياً أو غير متوفرة البيانات عنده ومستقبلاً حب يضيف داخل الحقل الفارغ البيانات المطلوبة ، كيف راح يقدر يبحث عنها إذا السجل أساساً ما ظهر وقت البحث !

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

ههههه انا عن نفسى عجبتنى حتة 1+1 دى مصرى مصرى يعنى بالنسبة للمرفق لا مجربتوش بس شكله شغل عالى انا عن نفسى فى مسألة الاستعلامات لو هعمل Criteria بعملها Like "*" بالطريقة التقليدية لأنى مبسيبش الحقول اللى هبحث فيها فارغة وادوخ نفسى ولو محتاج الاسم بالظبط بعمل المعيار Like بس واكتب الحاجة بالظبط عشان يتفلتر عليها انما ايه لزمة انى ابحث فى حقل سايب فيه Null Values ؟ ده رأيى واللى انا ماشى عليه

وانت واسرتك الكريمة بالف خير شكراً استاذ ياسر الكود يعمل بكفاءة عالية

@Amr Ashraf أستاذنا شكرا على التشجيع ههههه أنا خايف تكون جربت 1 + 1 ولم تجرب المرفق عاوزين نعرف لو فيه مشاكل ولا لأ ؟

جرب هذه المعادلات في الخلايا C3: =DATEDIF($A3,$B3,"y") E3: =DATEDIF($A3,$B3,"ym") G3: =DATEDIF($A3,$B3,"md")

يا جدعان انا قلت الراجل ده جامد تسلم ايدك ياباشا

اخى وحبيبى فى الله // ابو البراء السلام عليكم ورحمته الله وبركاته جزاكم الله تعالى عنى خير الجزاء وجزى أخى وحبيبى فى الله / بن عليه حاجى خير الجزاء اسأل الله تعالى أن يمتعكم بالصحة والعافية وان يتقبل منا ومنكم صالح الاعمال تقبلوا وافر تقديرى واحترامى وجزاكم الله خيرا

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

تمام الحمد لله أنا وصلت لنسبة فهم مرتفعة تتجاوز 50% وهذا يكفي لبدء التجربة وسأوافيك بالجديد إن شاء الله

يتعذر العمل على الجهاز بشكل كامل الآن .. إن شاء الله إذا لم يتدخل أحد الأخوة سأحاول العمل عليه ليلاً أو غداً إن شاء الله وأريد توضيح بمثال لشرط المناصفة لتتضح الصورة ..

وعليكم السلام جرب الكود التالي .. وكل عام وأنت بخير أخي الكريم محمد Sub CreateFolderOnDesktop() Dim strDir As String strDir = Environ("USERPROFILE") & "\Desktop\Test\" If Dir(strDir, vbDirectory) = "" Then MkDir strDir Else MsgBox "Directory Exists", 64 End If End Sub

وعليكم السلام من الممكن اعادة استثمار رسالة الخطأ برسالة مخصصة من قبلك إليك التعديل Linked tables.zip

ربنا يبارك فى ابناءك ويجعلهم من حفاظ كتابه * ولك منى كل التحية والتقدير

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

جزاك الله خير اخ عبدالفتاح ... مثال رائع .

الأستاذ خالد الرشيدي : أشكرك للتوضيح. فأنا استخدم هذه الطريقة عندما أقوم بعمل نسخة جديدة لعملي والقيام بالتعديلات في النسخة الجديدة وهكذا أتخلص من هذه الرسالة وأقوم بالتصحيح في النسخة الجديدة.

السلام عليكم اخى الكريم morestudy جزاك الله خيراً ولكن اعتقد ان هذه الطريقة ليست فعاله مع كل الحلات التى قد تسبب ارتباط - (Graphs/ charts - Named Ranges - Data Validation - Conditional Formatting ) بالطبع بالاضافة الى المعادلات - وهى وفقط تقوم بوضع القيمه الحاليه للخليه التى بها الارتباط وتحذف المعادلة ولكن ماذا لو كانت المعادلات مطلوبه - ؟؟؟؟ اخى الكريم ابو مرمر حقيقه عند تعليقى الاول لم اكن اشاهد الملف الذى ارفقته - لا اعلم لماذا ؟ اما وان قد شاهدته الان - فما كان يسبب الارتباط هو ال Drop Down 5 الموجوده شيت شهادات اول - لان حضرتك حددت ال Input Range لها 'C:\Users\mrmr_lolo\Desktop\[1 - Copy.xlsb]بيانات التلاميذ'!$E$13:$E$312 لهذا يمكنك تغيير ذلك او حذفها ان لم تكن بحاجه اليها - قمت بحذفها بالملف التالى new one_4.rar اما وعن السؤال الثانى قم بفتح موضوع جديد مشروح فيه المطلوب بشكل تفصيلى تقبلوا مرورى وتحياتى

استاذنا الغالى جمال لما فكرت فى الطريقة اللى انا شرحتها ظهرت كام مشكلة ممكن تحصل كالتالى : --فى حالة انى جبت كل المكونات لمنتج معين و عملت اضافة و قيمتها بالفعل وبقى ليها متوسطات اسعار بس المنتج لسة مشتغلش ومتعملش ليه اضافة وبالتالى متوسط سعر المنتج هيكون صفر وذلك لأنه هيحسب متوسطات اسعار المنتجات عند الاضافة . -- انا اعتمدت على كود الصنف مثلا كمبيوتر الموجود فى المثال طيب مثلا انا عندى 3000 نوع كمبيوتر (ديل - اتش بى - أسوس ) وكلهم نفس المكونات ونفس متوسطات الاسعار طيب فى الحالة دى هل هكتب البوم ( المكونات الداخلية ) الخاص بيهم كلهم هتبقى صعبة جدا وبالتالى كان لازم يبقى فيه محدد تانى وهو مثلا تصنيف يبقى الكترونيات ويندرج تحته ال3000 نوع كلهم وهيبقى Bom واحد للتصنيف كله وهتشوف الموضوع عملى . -- فى خطوات ممكن اختصارها وده هيوفر بعض الوقت والجهد وهشرحها . بالتالى كان لازم يبقى فيه طريقة مختلفة للحساب ولذلك فكرت فى طريقة وافضل فكرة كانت كالتالى ركز معايا : أولا : أنا عملت جدول جديد باسم Item Names زى دليل أصناف فيه جميع اكواد ومسميات المكونات والمنتجات اللى بستخدمها وقدام كل صنف خانة PrType ودى بكتب فيها تصنيف المنتجات فقط يعنى مثلا Computer i3 لكل أنواع الكمبيوتر i3 مثلا ديل أسوس وهكذا انظر المرفق لمزيد من الايضاح . و بالنسبة لجدول المنتجات اصبح الربط بتصنيف المنتج PrType وليس باسمه عشان نكتب المكونات مرة واحدة فقط ولا نكررها بتكرار المنتجات المتشابهة فى مكوناتها والمختلفة فى الاسم فقط تمام ؟ ثانياً : طريقة العمل المطلوبة 1 - طبعا احنا اول خطوة بنعمل اضافة للصنف الى المخزن و بعدين شخص تانى بيقوم مديها قيمة يدوياً (وطبعا دى بالنسبة للمكونات لأننا مش هنقيم المنتجات يدوى تمام ؟) ويقوم البرنامج حاسب متوسط سعر طبيعى زى مانتا عارف تمام ؟؟ طيب انا عاوز بعد ما يحسب متوسط السعر للخامة يقوم بحساب متوسط السعر للمنتجات اللتى تحتوى على هذا الصنف مثال : انا قمت بتقييم شاشة كمبيوتر بالتالى هيتم حساب متوسط السعر للشاشة والمطلوب بعدها حساب متوسطات اسعار جميع اجهزة الكمبيوتر لأن طبعا كل أجهزة الكمبيوتر فيها شاشات وبالتالى هتتأثر بالتغير اللى حصل لمتوسط سعر الشاشة تمام ؟ طيب بعد ما يحسب متوسط السعر للمنتجات اللى فيها المكون ده هيقوم كاتب المتوسط ده فى جدول Products فقط فى خانة Price امام تصنيف المنتجات اللى تحتوى على الصنف ده . الخطوة الأخيرة : نيجى لمرحلة الاضافة والصرف : أولا : فى حالة الاضافة او الصرف بيقوم البرنامج باحضار تصنيف الصنف ده فى جدول Item Names اللى هيا خانة PrType ومقارنتها بجدول المنتجات فى خانة Prtype برده ويشوف هل موجودة ولا لا لو موجودة يعنى الصنف ده منتج تام يقوم عامل احضار لقيمة Price الخاصة بيه وكاتبها فى AvgPrice فى جدول الحركات ثم ضربها فى الكمية سواء صرف او اضافة لينتج قيمة Zvalue تلقائيا تمام ؟ طيب فى حالة انه ملقاش التصنيف ده فى جدول المنتجات او كان التصنيف فارغ يبقى الصنف ده مكونات وبالتالى يقوم عامل اضافة او صرف بدون حساب اى معادلات او اى شئ ولكن ادراج سجل عادى بصورة طبيعية جدا .. طبعا لو لاحظت تلاقى الموضوع حلقة مكملة بعضها تضيف مكونات .. تديها قيمة .. تقوم حاسبة تكلفة المنتج .. تضيف او تصرف منتج يقوم جايب القيمة اللى اتحسبت فى الاول وهكذا .. طبعا الموضوع مجرد افكار وبتظهر مزاياها وعيوبها بالتطبيق زى ما حضرتك عارف والطريقة اللى هنقوم بيها متفرقش اهم شئ النتيجة المطلوبة يعنى لك الحرية انك تغير فى فكرة طالما هتوصل للمطلوب طبعا الموضوع طويل وشاق جدا وعارف انى بتعبك معايا بس انتا مش هتاكل كوارع ببلاش ربنا يجازيك خير ويتقبل صيامك ويرزقك الجنة ان شاء الله استاذى الفاضل تقبل تحياتى تقييم 7.rar لا متقلقش استاذى انا عامل حساب دى والافكار كلها بتعتمد عليها بس اضافة تعديل بسيط عليها فقط كما شرحت فوق

السلام عليكم ورحمة الله من المفروض أن الكود مفهوم جدا وعمله قد شرحته في ردي السابق، وإذا كنت تريد شرحا مستفيضا خطوة بخطوة فسأوافيك به، إن شاء الله، لاحقا... بالنسبة للتغيير الذي قمت به أكيد سينجح ولكن أريد أن أعرف لماذا تريد بالضبط طباعة النطاق a1:m83 دون غيره (فهو يحوي جوانب فارغة من الورقة وبالتالي يكون عدد الصفحات أكبر)؟؟ هل تعني بهذا تحديد "ناحية الطباعة" أم هذا النطاق بذاته؟ ثم إذا لم تكن عندك طابعة أو كانت معطلة فيمكنك استبدال كلمة PrintOut في الكود بكلمة PrintPreview حتى يكون لك "معاينة للطباعة" وتعرف بالتالي ما سيطبع من ورقتك... ملاحظة: إذا كنت تريد طباعة الجدول فقط دون الصفوف الفارغة بالأسفل أو غيرها فيمكنك استعمال خاصية "ناحية الطباعة" إما يدويا وإما برمجيا VBA * تحديد ناحية الطباعة برمجيا يكون بإضافة الأمر التالي إلى الكود قبل حلقة FOR مباشرة: ActiveSheet.PageSetup.PrintArea = Range("$A$1:$K$" & m).Address أو Sheets("Feuil1").PageSetup.PrintArea = Range("$A$1:$K$" & m).Address أو Feuil1.PageSetup.PrintArea = Range("$A$1:$K$" & m).Address وأمر الطباعة في الكود يكون: ActiveWindow.SelectedSheets.PrintOut Copies:=1 أو Sheets("Feuil1").PrintOut Copies:=1 أو Feuil1.PrintOut Copies:=1 يمكن حذف الجزئية Copies:=1 من هذا الأمر في الكود لأنها تحدد عدد النسخ المستخرجة... بن علية

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

بارك الله فيك وجزاك الله خير مثال جدا رائع وفقك الله

اسم برنامجك مميز هههههههه المفروض مصدر البيانات يكون مربع النص الذي تكتب فيه وليس العنوان المرافق لمربع النص مستخدم 2.rar

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

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

استاذى الفاضل اولا ان كان فيه سوء تعبير منى لتوصيل بعض الافكار سأحاول تبسيطها اما بالنسبة لأسئلتك لو المنتج جهاز كمبيوتر ملوش سعر ؟ فى الحالة دى هيبقى مكوناته زى الكيبورد والماوس وهكذا تمت اضافتهم وليهم متوسط سعر بالفعل وذلك عن طريق الفانكشن القديم فالمفروض الجديد بقى انه هيحسب متوسطات الاسعار للمكونات ويكتب متوسط السعر فى خانة avgPrice الاول ثم يضربها فى قيمة الاضافة اللى هيضيفها امين المخزن ويكتب الناتج فى zvalue ثم ينسخ الناتج ويضيفه فى Price فى الجدول التانى . وبالتالى متوسط السعر للمنتج هيتم حسابه بعد اضافة الكمية فى الوارد وبالتالى متوسط السعر للمنتج هيبقى فى مكانين الأول AvgPrice فى جدول Transactions والثانى Price فى جدول Products وبالتالى بالنسبة للمنتج الكامل زى الكمبيوتر متوسط السعر بتاعه فى حالة الاضافة فقط بيساوى مجموع متوسطات اسعار الخامات المكونة ليه اما فى حالة الصرف بيجيب اخر متوسط سعر للاضافة بالنسبة للمرفق هوا أدى نصف العمل بس طريقة الحساب مظبوطة جاب اخر متوسط سعر لكل مكون وجمعها وكتب الناتج فى Prices طيب انا عاوز اعمل اضافة بقى للمنتج ده اللى هوا الكمبيوتر طبعا حركات الاضافة والصرف بتتم فى جدول Transactions سواء الصنف مكونات او منتج كامل وبالتالى لما جيت اعمل اضافة للمنتج فى الجدول وضغطت على Run مجابش اخر متوسط سعر اللى هوا مكتوب فى Prices ومحسبش قيمته تلقائيا عارف ان الموضوع معقد بس عندى أمل فى ربنا ثم فيك اننا هنوصل للمطلوب بس بعد شوية تجارب جزاك الله خير استاذى على فكرة هعزمك على أكلة كوارع لما الفكرة دى تتم

ما شاء الله على هذا العدد أولا ما هي المدة الزمنية التي قضيتها في انشاء هذا العدد من التقارير ؟؟؟ ثانيا هل كل هذه التقارير في قاعدة واحدة ؟؟؟ هههههه ثالثا يمكنك تغيير الخاصية لجميع التقارير دفعة واحدة و لن ياخذ منك هذا و قتا طويلا انشئ نموذجا جديدا في القاعدة و أنشئ به زر أمر و أكتب خلف زر الأمر الكود التالي: Dim str_code As String Dim name_rpt As String Dim rpt As AccessObject, dbs As Object Set dbs = Application.CurrentProject For Each rpt In dbs.AllReports name_rpt = rpt.Name DoCmd.OpenReport name_rpt, acDesign Reports(name_rpt).PopUp = True Reports(name_rpt).Modal = True str_code = "Private Sub Report_Load()" & vbCrLf & _ "DoCmd.Maximize" & vbCrLf & _ "end sub" Reports(name_rpt).Module.AddFromString str_code DoCmd.Close acReport, name_rpt, acSaveYes Next ثم قم بتشغيل النموذج و انقر على الزر مرة واحدة سوف يقوم بإضافة الخصائص الموجودة بالكود لجميع التقارير و يمكنك إضافة أي خاصية تريدها لا تنسى أخذ نسخة إحتياطية من القاعدة قبل التطبيق

استأذن من استاذنا @Gamal.Saad واستأذن من استاذي الحبيب @رمهان اتفضل القي نظرتا الى الصورة انا غيرت مصدر كومبوبوكس والكود اصبح Private Sub comb_Search_AfterUpdate() On Error Resume Next Me.Filter = "[" & (Nz(comb_Search, "رقم المستفيد")) & "]" & " Like ""*" & FindAsType & "*""": Me.FilterOn = True End Sub Private Sub txt_Search_Change() On Error Resume Next FindAsType = txt_Search.Text Me.Filter = "[" & (Nz(comb_Search, "رقم المستفيد")) & "]" & " Like ""*" & FindAsType & "*""": Me.FilterOn = True txt_Search.SetFocus txt_Search = FindAsType txt_Search.SelStart = Len(FindAsType) End Sub واليك المرفق بعد تعديل مثال .rar

تمام اذاً سيصبح كود زر فتح التقرير هكذا Private Sub Command27_Click() DoCmd.OpenReport "tblEmployee", acPreview, , Me.fsubEmployee.Form.Filter End Sub بالتوفيق

الاخ علي اطلعت على المرفق ويحتاج تعديلات خلينا نعمل البحث اول فزر البحث لا يعمل وهنا سنطبق فكرة الاستاذ كامل السابقة ضع الكود التالي بديلا لكود البحث السابق لديم وسيصبح الكود بالشكل التالي وهي تطبيق لفكرة الاستاذ كامل Private Sub cmdSearch_Click() Me.fsubEmployee.Form.Filter = "[EmployeeDOB] Between #" & Me.txtDOBStart & "# AND #" & Me.txtDOBEnd & "#" Me.fsubEmployee.Form.FilterOn = True End Sub لما تخبرنا ان التجربة تمت بنجاح لزر البحث ننتقل لطباعة نتائج البحث بالتوفيق

أبشروا بما يسركم جميعا بفضل الله تمكنا من حشو الكمبوبوكس بقائمة من عمودين الثانى اسم التقرير والأول التسمية التوضيحية للتقرير الموجودة بنافذة الخصائص والتشغيل بارك الله فيكم إنجاز رائع بفضل الله ثم بفضل اقتراحات أبى خليل تفضل جلب أسماء التقارير و أسمائها التوضيحية العربية و تشغيلها من كمبوبوكس كود أسماء كل 8التقارير.rar

فضلا لا أمرا الرجاء تغيير اسم ظهورك إلى اللغة العربية كما هو معمول به في هذا المنتدى تم عمل المطلوب تفضل ZZمرتبات1.rar

تمام كده أنا كنت بأجرب على مجموعة من الملفات دون غيرها لا يظهر معها هذا الخطأ ولهذا ذكرت أن الكود ليس به أخطاء خاصة و أن النتائج النهائية صحيحة 100 % نحن الآن بانتظار رأى أبو يوسف فى المرفق الأخير يا رب يكون مرضى وصل لمبتغاه

أخي الغالي مختار يوجد بالفعل خطأ في أثناء تنفيذ الكود مع الملفات التي بها صفين فقط من البيانات فقمت بتعديل الكود بحيث يزود كمان صف على الموجود كما قمت بإدراج الإحصاء في العمودين Y و Z بدلاً من العمودين M و N لأنني لاحظت أن بعض الملفات بها بيانات في هذين العمودين للأسف وأكرر للأسف تحدث مشاكل حين يكون المرفق غير معبر عن الملفات الأصلية .. لأننا اشتغلنا على مجموعة ملفات لها نفس المواصفات أما عند إرفاق ملفات جديدة لها مواصفات جديدة فكان لابد من التغيير ليتلائم الكود مع الوضع القائم عموماً إليك المرفق التالي فيه المصنف الرئيسي ومرفق ملفات CSV الأخير المسمى girl (قم بتغيير اسمه ..ولن يؤثر في شيء) Collect Data From Multiple CSV Workbooks Mokhtar YasserKhalil V4.rar

السلام عليكم ورحمة الله وبركاته أخى أبو يوسف جرب هذا الكود حساب عدد التكرار لكل مكتب في جميع الاوراق و أبدى ملاحظاتك Option Explicit Sub CopyToNewSheet() ' by Mokhtar Hussien ' 25/11/2015 Dim SH As Worksheet Dim P As Long Dim Rng As Range Dim Data, ColFound Dim Obj As Object Application.ScreenUpdating = False Application.DisplayAlerts = False '----------------------------------------------------------------- Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "التجميعى" '----------------------------------------------------------------- For Each SH In ThisWorkbook.Sheets If IsError(Application.Match(SH.Name, Array("Master", "التجميعى"), 0)) Then SH.Range("M2").CurrentRegion.Offset(1).Copy With Sheets("التجميعى") .Activate .Range("B1:C1") = Array("مكتب التربية", "العدد") .Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll With .Range("B1").CurrentRegion .Range("A1:B1").Interior.Color = vbYellow .Borders.Weight = xlThin .BorderAround Weight:=xlThick .Columns.AutoFit End With End With End If Next '----------------------------------------------------------------- With Sheets("التجميعى") ColFound = Application.Match("*مكتب التربية*", .Rows(1), 0) If IsNumeric(ColFound) Then .Range("G2:H2") = Array("الاحصاء النهائى لمكاتب التربية", "الجملة") Set Rng = .Range(.Cells(2, ColFound), .Cells(.Cells(Rows.Count, ColFound).End(xlUp).Row, ColFound)) Set Obj = CreateObject("scripting.dictionary") Data = Rng For P = 1 To UBound(Data) Obj(Data(P, 1) & "") = "" Next .Range("G3:G1000").ClearContents .Range("G3").Resize(Obj.Count, 1) = Application.Transpose(Obj.keys) '----------------------------------------------------------------- With .Range("H3:H" & .Cells(Rows.Count, "G").End(xlUp).Row) .Formula = "=SUMPRODUCT( (R2C2:R1000C2 =RC[-1]) * R2C3:R1000C3 )*2" .Value = .Value End With '----------------------------------------------------------------- With .Range("G2").CurrentRegion .Borders.Weight = xlThin .BorderAround Weight:=xlThick .Columns.AutoFit .Range("A1:B1").Interior.Color = vbYellow End With '----------------------------------------------------------------- .Columns("A:F").Delete Shift:=xlToLeft '----------------------------------------------------------------- End If End With '----------------------------------------------------------------- Sheets("Master").Activate Application.CutCopyMode = False Application.ScreenUpdating = True Application.DisplayAlerts = False End Sub أخى و أستاذى ياسر راجع هذا الكود و ان كان يحتاج لتحسينات فتفضل مشكورا تحياتى Collect Data From Multiple CSV Workbooks Yasser Mokhtar final.rar

السلام عليكم ورحمة الله وبركاته بعد اذن اخى الحبيب سليم حاصبيا ده حل اخر ... باحد اكواد المنتدى لاخينا العبقرى ... الحسامى ترحيل ناجح ودور ثانى.rar

هذا ما استطعت ان افعله لعله ينال الاعجاب ادخل على صفحة "فهرس"و سوف ترى store_v3.rar

الاكسس 2010 لا يدعم اخفاء شاشة الاكسس لكن يدعم اليه جديدة اسمها ريبون Ribbon وهي خاصية اجمل واكثر كفائة من اخفاء اطار الاكسس حيث من خلال هذه الميزة تستطيع صنع ايقونات وشريط مهام خاص بك . واعتقد يوجد لدي موضوع عن ذلك . ارفق لك مثال عن هذه الخاصية . EN.rar