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

جرب هذا الملف هناك معادلة في الشيت "data" العامود "I" (مخفي) لا يجب ان تمسح لانها تحدد المكرر من غير المكرر (غير المكرر تعطيه رقم 1) على اساس هذا الرقم تتم الفلترة (عند الضغط على الزر Run من صفحة "data") الفلتر يتعامل رأساً مع الصفحة "data" و ينقل النتيجة الى الصفحة "Summary" الكود Option Explicit Sub filter_More_critertias() With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Dim S_sh As Worksheet: Set S_sh = Sheets("data") Dim T_sh As Worksheet: Set T_sh = Sheets("Summary") Dim My_Table As Range: Set My_Table = S_sh.Range("b5").CurrentRegion T_sh.Range("b5").CurrentRegion.Clear T_sh.Range("q6").Formula = "=data!I6=1" My_Table.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=T_sh.Range("Q5:q6"), _ CopyToRange:=T_sh.Range("b5") '=============================== With T_sh .Range("q6").Clear .Columns("i").Clear .Sort.SortFields.Clear .Sort.SortFields.Add Key:=Range("H6") _ , SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _ "الاول,الثاني,الثالث", DataOption:=xlSortNormal With .Sort .SetRange Range("B5").CurrentRegion .Header = xlYes .Apply End With End With With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub الملف مرفق ترحيل لورقة واحدة Salim.xlsm

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

برنامج صغير لواجهة الدخول اهداء لكم username admin 123 username user 456 واجهة دخول.accdb

تفضل اخى الكريم -حساب العمر بالسنة والشهر واليوم.xlsx

حرب هذا الكود Option Explicit Sub giVe_data() Dim My_Sh As Worksheet Dim st$, MY_Rg As Range Dim final_row%, K%, i%, m%: m = 8 Dim result$ Set My_Sh = Sheets("ورقة1") With My_Sh .Range("h5:j5").ClearContents st = .Range("h3") final_row = .Cells(Rows.Count, "B").End(3).Row Set MY_Rg = .Range("c5:E" & final_row) For i = 1 To 3 For K = 5 To final_row If MY_Rg.Cells(K - 4, i) = st$ Then result = result & _ .Cells(MY_Rg.Cells(K - 4, i).Row, 2) & "-" End If Next If result <> "" Then .Cells(5, m) = Mid(result, 1, Len(result) - 1) End If m = m + 1 result = "" Next End With End Sub الملف مرفق Espece.xlsm

اتفضل حسب طلبك كتابة المبلغ.accdb

اعتقد انه لا ضرورة للترحيل من صفحة الترحيل لان الكود يقوم بترحيل كل شيء و يقوم بترتيبها بدل ان تقوم في كل مرة بالتبديل بين (الاول والثاني والثالث) في صفحة الترحيل ( اي اجراء حلقة تكرارية لتنفيذ ماكرو واحد 3 مرات متتالية) اما صفحة الترحيل اتركها لفرز البيانات بعد تنفيذ الماكرو تستطيع ان تذهب الى صفحة Summary و تجري هناك عملية Remove duplicates على كل الاعمدة ما عدا العامود الاول (حيث الترقيم) (يمكن تحرير ماكرو لهذا الغرض عند حذث Worksheet_Activate) او بواسطة زر يوضع في هذه الصفحة يقوم بهذا العمل الماكرو المطلوب Sub Remove_Dup() Sheets("Summary").Range("b5").CurrentRegion.RemoveDuplicates _ Columns:=Array(2, 3, 4, 5, 6, 7), Header:=1 End Sub

اتفضل اتمنى يكون حسب طلبك حماية.rar

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

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

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

تفضل الكود المعدل Sub Macro1() If ActiveSheet.Name <> "ورقة1" Then Exit Sub Range("C16:G1015").Select ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("G16:G1015") _ , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("E16:E1015") _ , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("F16:F1015") _ , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("D16:D1015") _ , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.ActiveSheet.Sort .SetRange Range("C16:G1015") .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("C14").Select End Sub

السلام عليكم ورحمة الله صحح الجزئية التالية في الكود G1015" & LR بالجزئية : G" & LR بمعنى حذف الرقم 1015 في الأمر الملزن بالأصفر ثم في الأوامر (الثلاثة) التي تليه... والكود يصبح كالتالي: Sub Macro1() If ActiveSheet.Name <> "ورقة1" Then Exit Sub Dim LR As Long LR = Range("C" & Rows.Count).End(xlUp).Row Range("C16:G" & LR).Select ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("G16:G" & LR) _ , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("E16:E" & LR) _ , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("F16:F" & LR) _ , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("D16:D" & LR) _ , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.ActiveSheet.Sort .SetRange Range("C16:G" & LR) .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("C14").Select End Sub بن علية حاجي

تفضل يا أخى Hassan.xlsm

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

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

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

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

مصدر التقرير استعلامQ1 واستعلام Q1 مصدره جدول TBL2 فقط هو اضاف في الاستعلام هذا Rasid: [EndtharYear]+[EndtharSum] وهذا BookValue: [Cost]-[Rasid] ثم جعل مصدر التقرير استعلام Q1 واضاف له هذا end: DSum(" [EndtharSum] ";"[Q1]";"[id]<=" & [id] & "and [PrivetCode]= Reports![rep1]![PriavetCode] ") اظن هذا شرح كافي ووافي تحياتي

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

ali mohamed ali استاذى ربنا يعزك يارب والف شكر ليك

ممتاز ورائع وشرح وافى وكافى بارك الله فيك استاذى الكريم

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

والآن نشرح طريقة العمل بالملف المرفق أضفت لك العمود الأصفر (الذي سوف يستخدمه برنامج السولفر) لاحظ أن هذا العمود (أو هذه الخلايا) يجب ألا يحتوي علي أية معادلات نهائيا وكلما قل عدد الخلايا التي سوف يتعامل معها السولفر يكون الحل أسرع ثم بفرض أن هذا العمود لن يحتوي إلا أحد رقمين (0 أو 1) - لمن لديه فكره هذان هما الرقمان الوحيدان المكونان للأرقام الثنائية Binary Numbers العمود الذي يليه ضع فيه معادلة حاصل ضرب ذاك العمود بقيمة الفاتورة المقابلة وبآخره بالخلية D58 (الفونط الأحمر) معادلة جمع لهذا العمود الأخير .... أي لو أن كل الأصفر = 0 يكون مجموع الفواتير التي تم اختيارها =0 ولو أن كل الأصفر = 1 يكون مجموع الفواتير التي تم اختيارها يساوي إجمالي كما بالعمود B أي = 1,165,911 والآن سنجعل السولفر يغير الخلايا الصقراء بمحاولات متعددة بشرط ألا تحتوي هذه الخلايا إلا أحد رقمين (0 أو 1) ويكون هدف السولفر تقليل الناتج بالخلية E58 الخضراء والتي بها المعادلة التالية =(D58-309510)^2 هذه المعادلة تعظم الفارق بين المجموع للخلايا التي يختارها السولفر والرقم الذي تريده ورفعها للأس 2 لكي نجعل الفارق دائما موجب لأن هدف السولفر كما قلنا تقليل الناتج بالخلية E58 التي بها المعادلة ============================ أخيرا كيف تحدد المشكلة للبرنامج ليعطي نتائج مضبوطة قف بالماوس علي الخلية E58 التي بها المعادلة ثم إضغط زر السولفر ، سيبدو لك كما بالصورة قائمة توضح أن الهدف هو الخلية E58 ثم تختار Min ثم تختار الخلايا التي تسمح للسولفر أن يغير محتواها (الخلاي الصفراء) وأخيرا ضع شرطك أو شروطك بعد أن تضغط Add وفي هذه الحالة شرط واحد أن الخلايا الصفراء لابد أن تكون كلها من الأرقام الثنائية Binary Numbers وبالنهاية إضغط زر Solve لتشغيل البرنامج ستجد أنه قد يستغرق عدة دقائق (حسب قدرة الجهاز عندك) لأنه يجرب آلاف بل ملايين المحاولات ليحصل علي النتيجة الصحيحة وبالأخير يعطيك النتائج كما بالملف المرفق لاحظ أن النتيجة لم تكن نهائية حيث أنني أوقفت عمل البرنامج بعد 10 دقائق كانت أقرب نتيجة 309,515 وليست 309,510 كما تريد بفارق 5 قد يستطيع الحصول علي الرقم بالضبط إن كان لها حل أو أقرب رقم كما تري جرب الملف المرفق مع قراءة ماسبق من الشرح حتي تجيد استخدام هذه الاداة الرائعة (السولفر) سولفر-فواتير.xlsx

شكرا لمجهودك ولوقتك الثمين الذي لم اقصد ان اضيعه

وعليكم السلام نعم يمكن 1- تستخدم الوحدة النمطية الخاصة بالتاريخ الهجري ( ابحث عنها فهي موجودة في غالب الامثلة في هذا المنتدى) 2- يفضل جعل نوع حقل التاريخ الهجري نصيا السبب لتلافي التعارض .. فبعض التواريخ لا يقبلها اكسس اذا كان الحقل وقت/تاريخ

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

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

هذا فيديو كما طلبت

تفضل اخى الكريم سند صرف.xlsm

Like "*" & fx() & "*"

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

احسنت يا بشمهندس كود ممتاز وادى الغرض بارك الله فيك جزاك الله كل خير

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

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

الاخ waleed907 السلام عليكم  هذا البرنامج كان من تصميمي الشخصي وكان بعنوان (برنامج قروض للمبتدئين)اكسس 2003 ورفعته على مندى اوفسينا للفائدة منذ مدة ليست ببعيدة ومنتديات اخرى مملكة الاكسس والمحيط العربي منذ مدة بعدما اجريت عليه بعض التعديل ليتوافق مع اكسس 2013 ورفعته على مندى اوفسينا فهل من المعقول ان يظهر بحلة جديدة بزيادة لنموذجين وبعنوان جديد وباسم مصمم اخر اعتقد ان هذا الامر ........ (مصادرة لجهود الآخرين) رجاءً لاتاخذ برامج غيرك وتسميها باسمك كمصمم اليك البرنامج الاصلي من تصميمي تفضل قروض.rar

جرب هذا الملف copy sheet.rar

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

طريقة أخرى للحل إلى جانب طريقة أستاذى ( يحيى حسين ) أسماء اللاعبين.rar

السلام عليكم و رحمة الله أخي ابو عبدالعزيز شاهد الملف المرفق و لتغيير اللعبة من خلال الخلية G2 أسماء لاعبين و ألعابهم.rar