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

السلام عليكم ورحمة الله جرب المرفق لعل فيه ما تريد (مع بعض الزيادة).... بن علية حاجي معادلة الترقيم والتسلسل بدون تكرار.xlsx

كيفية عمل فورم من خلال الفرام وتخطيط جدول وادراج ماديول جذء 2 الفيديو الصور الملف شرح كيفية عمل فورم من خلال الفرام وطريقة عمل جدول الجذء الثانى.rar

كود جديد بقوم بما تريده تم تغيير اسماء الضفحات لسببين 1- لا أطيق العمل بالكود مع اللغة العربية لصعوبة اتجاهات الكتابة (تارة من الشمال اى اليمين وطوراً بالعكس) 2-سهولة نسخ الكود بدون ان تظهر حروف غريبة) Option Explicit Sub Give_data() Dim Dict As New Dictionary Dim Itm#, i%: i = 2 Dim K Dim SA As Worksheet: Set SA = Sheets("Salim") Dim Mab As Worksheet: Set Mab = Sheets("Mabi3at") Dim X#: X = Application.CountA(Mab.Range("b:b")) With SA.Range("A4").Resize(X) .ClearContents .Offset(, 6).ClearContents End With Do Until Mab.Range("b" & i) = vbNullString K = Mab.Range("b" & i): Itm = Mab.Range("d" & i) If Not Dict.Exists(K) Then Dict.Add K, Itm Else Dict(K) = Dict(K) + Itm End If i = i + 1 Loop With SA.Range("a4").Resize(Dict.Count) .Value = Application.Transpose(Dict.Keys) .Offset(, 6).Value = Application.Transpose(Dict.Items) End With Dict.RemoveAll End Sub الملف SUM_WITH DICTIONARY.xlsm

انه مزاح برئ والله ليس اكثر ولا اقل وانا احب كل اخوتى واقدم المساعدة والله للجميع بقدر المستطاع دون التفرقة بين اخوتى واحبتى يمكن من كثرة الآمى والله حاولت المرح قليلا لان فعلا اليوم انا تعبت جدا جدا جدا جدا الحمد لله على كل حال والحمد الذى بفضله لم افطر ولا يوم حتى الان لكن اثار الدواء والعملية الجراحية اتعبونى جدا جدا وارهقونى لدرجة فقدان التركيز والله فحاولت المرح علنى الهو حتى يأتى موعد الافطااااار لربما انسانى هذا الآمى واوجاعى قليلا لكن الاستاذ والاخ الجميل @محمد صلاح1 مصر يجننى وربنا كل شوية يسأل سؤال فى سؤال ويفتح موضوع فى موضوع المفروض انتهى

السلام عليكم ورحمة الله استخدم الكود التالى لاحظ الكود سيتغرق تنفيذه حوالى 5 ثوانى او اكثر Sub SumIfCod() Dim ws As Worksheet, Sh As Worksheet Dim C As Range, i As Long, x Dim Rng As Range, LR As Long, y As Double Set ws = Sheets("الاصناف") Set Sh = Sheets("المبيعات") LR = Sh.Range("B" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False T = Timer i = 4 Do While ws.Range("A" & i) <> "" x = ws.Range("A" & i).Value y = WorksheetFunction.SumIf(Sh.Range("B2:B" & LR), x, Sh.Range("D2:D" & LR)) ws.Range("G" & i) = y i = i + 1 Loop MsgBox (Timer - T) Application.ScreenUpdating = True End Sub

استاذ وجيه لك كل الشكر علي كلماتك ومرورك

الاستاذ / أباالحسن السلام عليكم ورحمة الله شكرا علي هذا المحهود الرائع في برنامج مرتبات المعلميين والاداريين ملحوظة صغيره : يرجي مراجعة طريقة حساب ضريبة كسب العمل وكذلك المفردات التي تدخل ضمن حساب الايراد والاعفاءات * فمثلا الاساسي المجرد ( في 1 / 7 / 2018 تم منح العاملين بالدولية علاوه استثنائية (200 او 190 او 180 جنية ) تضاف علي الاساسي في 1 / 7 / 2018 وهي غير معفية من الضرائب * حساب ضريبة الكسب عند تفسيم المرتب الي شرائح فان الاعفاء الممنوح يتم علي اعلي شريحة بالنسبة للموظف الاول ابو الحسن الشريحة الاولي 22000 جنية يستحق عليها ضريبة 10 % = 2200 جنية الشريحة الثانية 1780جنية يستحق عليها ضريبة 15 % = 267جنية اجمالي الضريبة المستحقة 2200+ 267 = 2467 جنية يتم منح هذا الموظف اعفاء بنسبة 45 % من اجمالي الضريبة ويتحمل نسبة 55 % الضريبة المستحقة = 2467 * 0.55 = 1356 جنية تقسم علي 12 شهر = 113 جنية هذا و الله اعلي واعلم ارجو تقبل هذه الملحوظة وتداركها

إضغط هنا >>>----->>يا باغى الخيــر أقبل 6 دقائق تأخذك الى الفردوس الأعلى لا تبخل على نفسك<<-----<<< إضغط هنا

Expand And Collapse( الطى والتوسيع ) ExpandCollapse( الطى والتوسيع).mdb

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

بص المنشور السابق لردك مباشرة قلت لك ايه انا بس كنت منتظر اشوف انت هتحتاج شئ تانى واللا لاء والتجربة عجبتك اصلا واللا هتزعق لى اتفضل طالما راض عن النتيجة دى EngArb (4).accdb

لسه فى شئ تانى بس انا منتظر ردك الاول طبعا بعد التجربة

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

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

انا قمت بضغطه واعادة رفعة مرة اخرى حتى يستطيع اساتذتنا الكرام متابعة العمل معك برنامج_العقود.zip

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

أي صنف تزيده او تعدل قيمته يظهر في النتيجة طيعاً بعد تنفيذ الكود بالضغط على الزر ملاحظة الكود يتوقف عن العمل عند اي صف فارغ في شيت الاصناف لذلك لا تترك اي فراغ بين البيانات و اذا اردت حذف صنف من الاصناف عليك حذف (الصف او الصفوف) بالكامل لا لزوم لترتيت الاصناف لان الكود لا ينظر الى المكرر مع انه يقوم بجمع القيم للمكررين مثلا يمكن في اخر صف ادراج الصنف1 و بعده صنف 50 ثم صنف 4 الخ....

الله اعلم لن احاول عمل ذلك او تجربته من قبل جرب انت واخبرنا بالنتيجة

اخي وجيه شرف الدين شكرا جزيلا لك ولسليم حاصبيا اللهم اعن من اعانني وهدي من اعانني ورزقه رزقا حلا طيبا

---------------------- الطامع_فى_الفردوس_الأعلى.zip

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

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

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

طبعا انا مش عارف مصادر بياناتهم ايه انت ادرى برنامج_العقود.accdb RptAll

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

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

ارفق بى وابدا العد بعد العيد ان شاء الله وابشرك ان شاء الله بهدية قيمة بس فعلا بدات فقدان التركيز تماما فلا لن استطيع الان

وانا سوف ادعوا لكم انتم الاتنين ربنا يوفقكم ويتقبل منك صالح الاعمال وكل سنه وانتم طيبين

هههههههه

انظر الى هذا التعديل لعله يفى بالغرض التعديلsumif.xls

اي يعني لما بيكون المجموع صفر يفترض ان يضع صفر على كل حال اذا كنت لا تريد الصفر يمكن التعديل وذلك باضافة شيء بسيط على سطر واحد بالكود ( ما بين اشارات +++++) Option Explicit Sub sum_if_by_code() Application.ScreenUpdating = False If ActiveSheet.Name <> "الاصناف" Then GoTo Exit_Sub Dim SH_Mab As Worksheet: Set SH_Mab = Sheets("المبيعات") Dim SH_Asnaf As Worksheet: Set SH_Asnaf = Sheets("الاصناف") Dim Rg_Mab As Range Dim Rg_Asnaf As Range Dim My_cel_Mab As Range Dim My_cel_Asnaf As Range Dim m%: m = 0 SH_Mab.Select Set Rg_Mab = SH_Mab.Range("b2", Range("b1").End(4)) SH_Asnaf.Select SH_Asnaf.Range("G4", Range("G3").End(4)).ClearContents Set Rg_Asnaf = SH_Asnaf.Range("a4", Range("a3").End(4)) For Each My_cel_Asnaf In Rg_Asnaf For Each My_cel_Mab In Rg_Mab If My_cel_Asnaf = My_cel_Mab And _ IsNumeric(My_cel_Mab.Offset(, 2)) Then _ m = m + My_cel_Mab.Offset(, 2) Next Rem ++++++++++++++++++++++++++++++++++++++++++++++ My_cel_Asnaf.Offset(, 6) = IIf(m = 0, vbNullString, m) Rem++++++++++++++++++++++++++++++++++++++++++++ m = 0 Next Exit_Sub: Application.ScreenUpdating = True End Sub

حاول تكمل برنامج_العقود.accdb

كيفية عمل فورم من خلال الفرام وطريقة حفظ الملف جذء 1 الفيديو الصور كيفية عمل فورم من خلال الفرام وطريقة حفظ الملف.rar

لم افهم شيء من ملفك النطاق A1:Ak2 Activesheet يحتوي عل خلايا فارغة عندك مشكلة في الخلايا المدمجة (علة العلل للعمل بالاكواد) غير ذلك تريد تنفيذ ماكرو على Activesheet في هذه الحالة الماكرو سوف يعمل على الشيت النشطة حتى وان كانت غير المطلوبة لذا دائماً قم بتحديد الشيت المعني بالأمر

لاكتشاف الخطأ يجب تشغيل الكود على الملف مباشرة لذا قم بتحميل الملف او جزء منه اذا كان كبيراً

انظر الصورة اخي الكريم ربما تفيدك

ممكن هذا الكود بدون SumIf Option Explicit Sub sum_if_by_code() Application.ScreenUpdating = False If ActiveSheet.Name <> "الاصناف" Then GoTo Exit_Sub Dim SH_Mab As Worksheet: Set SH_Mab = Sheets("المبيعات") Dim SH_Asnaf As Worksheet: Set SH_Asnaf = Sheets("الاصناف") Dim Rg_Mab As Range Dim Rg_Asnaf As Range Dim My_cel_Mab As Range Dim My_cel_Asnaf As Range Dim m%: m = 0 SH_Mab.Select Set Rg_Mab = SH_Mab.Range("b2", Range("b1").End(4)) SH_Asnaf.Select SH_Asnaf.Range("G4", Range("G3").End(4)).ClearContents Set Rg_Asnaf = SH_Asnaf.Range("a4", Range("a3").End(4)) For Each My_cel_Asnaf In Rg_Asnaf For Each My_cel_Mab In Rg_Mab If My_cel_Asnaf = My_cel_Mab And _ IsNumeric(My_cel_Mab.Offset(, 2)) Then _ m = m + My_cel_Mab.Offset(, 2) Next My_cel_Asnaf.Offset(, 6) = m m = 0 Next Exit_Sub: Application.ScreenUpdating = True End Sub

اين ذهب الماكرو الذي قمت انا بانشائه ===> لا لزوم له تم مسحه هل الماكرو الذي احدثته انت يتولى هذه المهمه اضافة الى مهمة انشاء صفحة جديدة ===> بالطبع هذه مهمته 1- اذا كان عدد الصفوف المملوءة في الشيت الاخير اقل من 11 يتم اضافة ما تريد الى اول صف فارغ في نفس الصفجة حتى يصل عدد الصفوف الى 11 2- و اذا كان عدد الصفوف المملوءة في الشبت الاخير يساوي 11 يتم ادراج شيت جديد الذي يأخد اسم الشيت الذي قبله زائد واحد ويذلك يكون هذا الشيت قد اصبح بدوره اخر شيت و تتم اضافة ما تريد اليه ابتداء من الصف الثاني حتى الرقم 11 ووهكذا دواليك

تفضل .... Dim dbs As Database, tdf As TableDef Set dbs = CurrentDb For Each tdf In dbs.TableDefs If Left(tdf.Name, 4) <> "msys" _ And tdf.Attributes = 1 Then tdf.Attributes = tdf.Attributes - dbHiddenObject End If If tdf.Attributes = 1073741825 Then tdf.Attributes = 0 Next tdf Set dbs = Nothing Call ViewTablePage

هل جربت هذا الكود .... Private Sub ViewTablePage() DoCmd.SelectObject acTable, , True SendKeys "{F5}" End Sub Private Sub VisibleTable_Click() Dim db As Database Dim tdf As TableDef Set db = CurrentDb For Each tdf In db.TableDefs If Left(tdf.Name, 4) <> "msys" And tdf.Attributes <> 1073741824 Then tdf.Attributes = tdf.Attributes + dbHiddenObject End If If tdf.Attributes = 1073741824 Then tdf.Attributes = 1 Next db.Close Set tdf = Nothing Set db = Nothing Call ViewTablePage End Sub

وعليكم السلام اخى الكريم فقد تم عرض هذه المشاركة ومناقشتها من قبل على هذا الرابط https://www.officena.net/ib/topic/54296-حساب-مرتب-عنوان-معدل/ حساب الراتب الحالى للموظفين.xlsx

السلام عليكم في البداية مقال جميل إجمالاً و جٓمالاً، لكن على حسب تجربتي المحدودة هناك أمر - أو مجموعة منه -أحب أن أشارككم به. أكسس المستخدم على السيرفر يختلف عن ذاك على الحاسب المحلي لجهة السرعة و لجهة عتبة الانهيار. كفاءة الجهاز لها دور كبير بوصول الأكسس إلى حده الأقصى. أخيراً هذه المعطيات عن الأكسس نظرية فالكثيرون لم يستطيعوا الوصول إلى قاعدة بيانات بحجم ١ جيجا و الأمر مركب للغاية. فعدد السجلات عامل هام في تحديد سقف حجم قاعدة البيانات . فلو فرضنا أن قاعدة بيانات وصلت إلى ما يقارب المليون سجل حتى مع عدم بلوغها ١ جيجا فستبطأ و ربما تكثر حالات الكراش حتى الإغلاق النهائي، و ما أعلمه أن الرقم القياسي كان حوالي ٧٠٠ ألف سجل لا أعلم ما حل بتلك القاعدة بعد ذلك. المعادلات في الاستعلامات تقصر عمر قاعدة البيانات خاصة تلك التي تستعرض السجلات كاملة مثل Dcount-Dmax ... و ستخفض عمر قاعدة البيانات بصورة كبيرة فالمليون سجل ربما تفقد صفراً !! العامل الآخر الذي شاهدت تأثيره السلبي هو النماذج الفرعية فهي فضلاً عن إبطاء عمل قاعدة البيانات و تأخير فتح البرنامج قد تحمل معها أخطاء غير معروفة شأنها بذلك شأن المعادلات الطويلة في الاستعلامات. و آخيراً الأحداث في الحالي التي تعتمد على البحث بيانات القاعدة كاملة كتلك التي نستخدمها لتعطي إشعارات بناء على عدد سجلاتٍ و نحوها فلها أثر مماثل . و كل هذا مرتبط بمسألة -لم أعرف لها تعليلاً - و هي تعديل البرنامج على حواسيب مختلفة المعالجات أو أنظمة التشغيل أو نسخ الأوفيس .

السلام عليكم ارجو تجربة المرفق وقد تم مراعاة معظم المشاكل لكن عليكي بان يكون القسم المدرج تحته البيانات مطابقا للعمل للتوضيح يجب ان يكون العمل مادة القرآن الكريم وليس القران تحت قسم مادة القرآن الكريم وقد تم عمل الملف بطريقة يسهل تعاملك معه بالرغم من انه استغرق 3 ايام لفكرة صغيرة وهي كيفية التعرف علي الاقسام والصف الاخير في كل قسم اخيرا بنفس طريقة عملك لهذا الملف صممي الملف الذي سيتم عليه عملك الفعلي والصقي نسحة فارغة من البيانات وليس من الاقسام في شيت Source فهو الشيت الذي يعتمد عليه لعمل نسخة لكل مدرسة ارجو انني قد فهمت المطلوب ونفذ بالطريقة الصحيحة ولو فيه اي استفسار انا منتظر للرد عليه تحياتي حافظة الدوام أوفيسنا.rar

كل صفحة من اكسل 2010 تحتوي على: 1,048,576 صف (اكثر من مليون صف ) 16,384 عامود (اكثر من 16000 عامود) اي 1048576 × 16384=17,179,869,184 خلية (اكثر من 17 مليار خلية ) اكثر بثلاث مرات عدد سكان الارض هل تستطيع أن تملأها بيانات للتأكيد هذا الماكرو Option Explicit Sub Cells_numbe() Dim x, y, z x = ActiveSheet.Rows.Count y = ActiveSheet.Columns.Count z = x * y Cells(1, 1) = "Rows Count" Cells(1, 2) = "Columns Count" Cells(1, 3) = "Cells Count" Cells(2, 1) = x Cells(2, 2) = y Cells(2, 3) = z End Sub

جرب هذا الماكرو Sub FIL_combo() Dim sh As Worksheet Dim obj As Object Set obj = _ CreateObject("System.Collections.Arraylist") For Each sh In Worksheets If sh.Name <> "Main" Then With sh.Range("b2") obj.Add .Value & " " _ & .Offset(, 1).Value End With End If Next Sheets("Main").ComboBox1.List = _ Application.Transpose(obj.toarray) obj.Clear: Set obj = Nothing End Sub Rem===============>> Salim Private Sub ComboBox1_DropButtonClick() FIL_combo End Sub الملف مرفق Masry_SALIM.xlsm

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

وعليكم السلام -لابد من رفع ملف العمل حتى تتمكن الأساتذة من المساعدة

السلام عليكم الكود صحيح وليس به اي مشكلة المشكلة في خصائص النموذج الذي تريد فتحه لذا اذهب الى قاعدة البيانات التي بها النموذج المراد فتحه افتح النموذج في عرض التصميم ومن خائص النموذج اختر التبويب -غير ذلك- وغير خيارات البند - منبثق - الى نعم وخيارات البند - شكلي او مشروط - الى نعم ثم اغلق قاعدة البيانات ثم اذهب الى قاعدة البيانات التي تريد فتح ذلك النموذج منها وضع الكود الذي كتبته في زر امر على النموذج عندها سيفتح النموذج كما تريد وهذا الكود تنقله كما هو فقط غير اسم مسار قاعدة البيانات واسم النموذج . Dim objAccess As Access.Application Dim strMDB, strForm As String Set objAccess = New Access.Application strMDB = "c:\DataBase.mdb" strForm = "Form1" With objAccess .OpenCurrentDatabase strMDB .DoCmd.OpenForm strForm End With