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

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

عدل اعدادا الجدول Main_DeviceT كما في الصورة .....

السلام عليكم اخي الكريم تفضل الشرح بالصور عن طريق التنيسق الشرطي (افتح النموذج في وضع التصميم ثم قم بتاشير الحقل ثم اضغط على التنسيق الشرطي) وباقي الشرح بالصور تم رفع الملف كامل بعد التعديل تحياتي قاعدة بيانات (220000).rar

السلام عليكم ورجمة االله بفضل الله وبحمده اوجدت طريقة ل تفويم البضاعة وفواتير المبيعات يطريقة الوارد اولا صادر اولا fifo ارفق اخواني لكم المثال متنمنيا ابداء النصح والتنويه على الخطا ان وجد fifomod17.zip

اخي العزيز @alix24028 ملاحظة مهمة جدا جدا 1- اذا كنت تريد ان تجعل حقل العمولة لكل عامل = صفر في حالة كان عدد العمال صفر / استخدم الكود التالي =IIf([WRCOUNT]=0;0;[Commission]/[WRCOUNT]) 2- اما اذا كنت تريد ان تجعل حقل العمولة لكل عامل هي نفس المبلغ حتى لو كان عدد العمل =صقر / استخدم الكود التالي =IIf([WRCOUNT]=0;[Commission];[Commission]/[WRCOUNT]) اتمنى تكمون فهمتني اخي العزيز تحياتي

اخي العزيز انظر لما كتبت بالاعلى وانظر للملف بعد التعديل حسب علمي يمكن التخلص من المشكلة باستخدام دالة IIf اتمنى ان يكون المطلوب واعلمنا النتائج تحياتي New D Report.rar

بعد اذن الاخ علي هذا الكود Option Explicit Sub Extract_by_Groupes() Rem Created By Salim Hasbaya On 19/2/2020 If ActiveSheet.Name <> "ورقة1" Then Exit Sub Application.Calculation = xlCalculationManual Dim ObjReg As Object Dim ObjMatches, a%, My_word, i% Dim k%, col%, last_row last_row = Cells(Rows.Count, 1).End(3).Row Range("E6:G" & last_row).Clear Set ObjReg = CreateObject("VBScript.RegExp") With ObjReg .Pattern = "(\W+)(\d+)[%-:,_](\W+)" .Global = True End With For k = 6 To last_row If ObjReg.test(Range("a" & k)) Then Set ObjMatches = ObjReg.Execute(Range("a" & k)) For Each My_word In ObjMatches 'The variable match will contain the full match a = My_word.Submatches.Count 'total number of groups in the full match col = 5 For i = 0 To a - 1 Cells(k, col) = My_word.Submatches(i) col = col + 1 Next Next End If col = 5 Next With Range("E6:G" & last_row) .Borders.LineStyle = 1 .Font.Size = 14 .Font.Bold = True .InsertIndent 1 .Columns.AutoFit .Interior.ColorIndex = 40 End With Set ObjReg = Nothing Application.Calculation = xlCalculationAutomatic End Sub الملف مرفق Extract Number.xlsm

سؤال اخي العزيز قبل ما افتح ملفك هل انت عامل حقل تم فيه قيمة تمت القسمة على صفر المهم حسب علمي أن نقسم أي عدد على الصفر ( مثل ما أردت ) فهذا يعتبره الآكسس خطأ رياضي أو كما يسمى .. (Division by zero) فهمت انك تريد تقسم العمولة على عدد العمال فيصبح الكود كالتالي =IIf([WRCOUNT]=0;[Commission];[Commission]/[WRCOUNT]) اخبرنا النتائج تحياتي New D Report.rar

كود رائع لكن من الافضل تقصير الحلقات التكرارية (لا داعي لتشغيلها حتى الصف رقم 1000 منها 995 صف فارغ) ما ادرانا عدد الصفوف ربما اكثر من 1000 أو اقل لماذا لا نجعل اكسل وحده يحدد عدد الصفوف (10 15 .... 100 ... 1000 الخ.) اقترح هذا الكود Sub rangeToColumn() Dim i%, m% i = 2: m = 2 Range("c2").Resize((Range("a2").CurrentRegion.Rows.Count) * 3) _ .ClearContents Do Until Range("a" & i) = vbNullString With Cells(m, 3) .Value = Range("A" & i) .Offset(1) = Range("B" & i) End With m = m + 2 i = i + 1 Loop End Sub

ارفع الملف نفسه لا يمكن التعامل مع صورة على كل حال اليك هذا النموذج الذي تستطيع العمل عليه Join_Columns.xlsx

السلام عليكم يمكن صياغة طلبكم بالصورة التالية: تريد أن يظهر الاستعلام وقت المغادرة هو آخر جمعة في غضون مدة 90 يوماً من تاريخ الوصول : بالنسبة للزائر تريد أن يظهر الاستعلام وقت المغادرة هو آخر جمعة بعد انقضاء 90 يوماً من تاريخ الوصول: بالنسبة للمقيم مع لحظ أنه في حال توافق اليوم الأخير مع يوم الجمعة بالنسبة للمقيم فينبغي أن يكون اليوم الأخير 91 . هل هذا المطلوب؟

تفضل اخي لقد وضعت كود بسيط اكتب الارقام التي تريدها وسيتغير الى السالب تلقائيا أرقام سالبة.xls

وعليكم السلام اتفضل اخى على هل هذا ما تريد ؟ تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق Daily Report V07 (2).accdb

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

السلام عليكم شكراً للقائمين على هذا المنتدى العملاق من مشرفين واعضاء لني تعلمت منهم الاكثير واتمنى لهم الموفقية والصحة الدائمة ان شاء الله تعالى. اخوتي انا اعرف ان في هذا المنتدى عمالقة التصميم والبرمجة وانا اعلم ان في هذا المنتدى افضل من هذا البرنامج ولكن لرد الجميل هذا المنتدى ارفع هذه نسخة من برنامج الصادر والوارد مفتوح المصدر برابط خارجي صممتة لصديق لي يعمل في شركة .... تحياتي لكم جميعاً.... https://up.top4top.net/downloadf-1058tvebj1-rar.html

السلام عليكم معكم ساجدة العزاوي من العراق اول مشاركة لي في المنتدى فديو مميز سهل رائع لاقى صدى واسع ينفع للكل للمدارس لدوائر الدولة للقطاع الخاص فديو عملته بـ 8 اجزاء ولما شفت كثيرين استفادوا منه عملت فديوين بعنوان في الاكسل متعة وسعادة وفرح فاصبح 10 اجزاء وساكمله باجزاء اخرى ... لانه رائع ومميز وسريع هناك من يريد تنسيبه لنفسه اترككم مع الفديو بحث بالاسم في TEXTBOX فيتم الفلترة الى LISTBOX وثم الى TEXTBOXES اكسل ساجدة العزاوي

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

بالخدمة استاذي الفاضل

احسنت استاد سليم

بارك الله فيك استاذنا الغالي كلك ذوق @husamwahab جاري التجربة وموافاتك بالنتيجة ..... كل الشكر والتقدير والاحترام .....🌷

نعم هي المطلوبه اخي العزيز لان الاوردر كتب ولم يخرج عليه عامل للعمل

السلام عليكم تفضل اخي العزيز ملاحظة : النتائج موجودة في الاستعلام الثاني اذا كانت صحيحة تستطيع ان تبني عليها نموذج ProgClac30.rar

جرب هذا الكود Option Explicit Sub Extract_by_Groupes() Rem Created By Salim Hasbaya On 19/2/2020 If ActiveSheet.Name <> "Salim" Then Exit Sub Dim ObjReg As Object Dim ObjMatches, a%, My_word, i% Dim k%, col%, last_row last_row = Cells(Rows.Count, 1).End(3).Row Range("C1:E" & last_row).Clear Set ObjReg = CreateObject("VBScript.RegExp") With ObjReg .Pattern = "(\w+)\s*?(\d+)\s*?([(]\s*?.\s*.+)" .Global = True End With For k = 1 To last_row If ObjReg.test(Range("a" & k)) Then Set ObjMatches = ObjReg.Execute(Range("a" & k)) For Each My_word In ObjMatches 'The variable match will contain the full match a = My_word.Submatches.Count 'total number of groups in the full match col = 3 For i = 0 To a - 1 Cells(k, col) = My_word.Submatches(i) col = col + 1 Next Next End If col = 3 Next With Range("C1:E" & last_row) .Borders.LineStyle = 1 .Font.Size = 14 .Font.Bold = True .InsertIndent 1 .Columns.AutoFit .Interior.ColorIndex = 15 End With Set ObjReg = Nothing End Sub الملف مرفق Ungroup_Text.xlsm

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

السلام عليكم اكتب او اختر من القائمة المنسدلة في الخلية m1 اخفاء اوراق العمل بناء على معلومة في خلية.xlsm

في أقرب وقت إن شاء الله. مساء اليوم أو غداً

بارك الله فيك أستاذ / خلف وجعله الله فى ميزان حسناتك ارجو ان انال بعضاً من وقتك فى هذا التعديل على النموذج المضاف للبرنامج جزاكم الله خيراً 2مثال.rar

بعد اذنك استاد سليم هذا ايضا قد يساعده بالكود ويمكن التحكم بالمدى على حسب بياناته merge data1‬.xls

السلام عليكم إليكم النموذج و الاستعلام. وفق ما وصلنا من طلبكم أرجو أن أكون قد وفقت لتلبية حاجتكم. بالتوفيق ملاحظة: في حال كان الاستعلام وفق ما تريدون سنتابع عمل بقية الطلبات. 2مثال.accdb

تمام بارك الله فيك أستاذ / خلف للزائر اذا توافق اليوم 91 يوم جمعة مافيش مشكلة للمقيم اذا تجاوز اليوم 91 الى اي جمعة اخرى مافيش مشكلة المشكلة هنا ان الزائر بعد 90 يوم يسدد غرامة كبيرة عكس المقيم اذا تجاوز الرقم 90 الى اي رقم يبقى لايوجد غرامة شرط استعلام يظهر الاسماء سواءاً ( زائر او مقيم ) هذه فى خلال عشرة ايام لزوم حجز الطائرة للمغادرة هل ممكن ينفع ان يكون لكل رحلة يوم زر يفتح الاستعلام الموافق لهذه الرحلة ( طبعاً الجمعة التى توافق الشهر الحالى ) ومرة اخرى اشكر حضرتك على سرعة الاجابة ... تحياتى لحضرتك

عروب الاعبيدات أين الضغط على الإعجاب لهذه الإجابة ؟!!!💙

جزاك الله أخي الكريم هو هذا المطلوب

المعادلة المطلوبة =IFERROR(VLOOKUP(A2,$H:$H,1,0),0)

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

تفضل..ببساطة كل ما عليك هو تحميل هذا النوع من الخط وستجد ما تريد barcodefont وستجد هذا الخط بالمرفقات قم بإدخاله ثم بعد ذلك يمكنك الإطلاع على الملف barcodefont.zip AMINE1.xlsx

اذا كان التاريخ المطلوب تحديد الاحد السابق و التالي له موجود فى الخلية D3 كما فى المثال المرفق ( الخلايا باللون الاصفر) معادلة الاحد السابق تكون: =IF(D3="","",D3-MOD(D3-1,7)) و معادلة الأحد التالي تكون: =IF(D3="","",D3+7-MOD(D3-1,7)) و طبعا يمكن تغيير المعادلة لترجع اي يوم اخر مرفق المثال للسهولة Officena Sundays.xlsx

تفضل قروض استعلام.accdb

بارك الله فيك استاذ حسن كود ممتاز-وبعد اذنك أخى الكريم ولإثراء الموضوع , هذا حل أخر بالمعادلات =COUNTIFS($B$4:$B$150,$E5,$C$4:$C$150,F$4) معادلة حساب عدد التوافق في الشرط من خليتين.xls

Option Explicit Sub test() Dim x1, x2, lr1, lr2 Application.ScreenUpdating = False Range("f5:h100").ClearContents lr1 = Range("b" & Rows.Count).End(xlUp).Row lr2 = Range("e" & Rows.Count).End(xlUp).Row For x1 = 4 To lr1 For x2 = 5 To lr2 If Cells(x1, 2) = Cells(x2, 5) Then If Cells(x1, 3) = "A" Then Cells(x2, 6) = Cells(x2, 6) + 1 ElseIf Cells(x1, 3) = "B" Then Cells(x2, 7) = Cells(x2, 7) + 1 ElseIf Cells(x1, 3) = "C" Then Cells(x2, 8) = Cells(x2, 8) + 1 'ElseIf Cells(x1, 3) = "D" Then 'Cells(x2, 9) = Cells(x2, 9) + 1 ' 'ElseIf Cells(x1, 3) = "E" Then 'Cells(x2, 10) = Cells(x2, 10) + 1 ' 'ElseIf Cells(x1, 3) = "G" Then 'Cells(x2, 11) = Cells(x2, 11) + 1 End If End If Next Next Application.ScreenUpdating = True End Sub جرب المرفق كود حلقات تكرارية 01.xls

اخي اليك احد محاولات FILTER.accdb

السلام عليكم ورحمة الله تعالى وبركاته اولا لم اجد استخدام الرموز الدولية الموحدة Unicode لا فى منتديات عربية ولا اجنبية ولا ادرى ان سبقنى اليها احد من قبل فى ستخدامها داخل الاكسس ولكنه توفيق من الله بالنسبة لى وسوف اشرح طريقة التوصل الى التعامل الصريح بـعلامة ( √ ) أو علامة ( x ) فى قواعد البيانات -------------- -------------- -------------- -------------- -------------- -------------- -------------- -------------- -------------- واخيـــــــــــــ( المرفق )ـــــــــــــــرا ( √ ) أو ( x )علامة.mdb

السلام عليكم, في السابق كنت استخدم خطوط معينة في برامجي وعند اعطاء البرنامج للعميل لاتظهر الخطوط التي قمت باستخدامها بل يظهر بمكانها الخط ( Arial ) وهذه مُشكلة. كت في وقتها الجأ الى ان اضع الخط بجانب قاعدة البيانات وفي داخل قاعدة البيانات اقوم بعمل تحقق لمجلد Fonts والبحث عن الخط في بداية تشغيل القاعدة, فإن لم يجده يعي رسالة للعميل بان الط مفقود وعليه ان يقوم بتثبيته من جانب البرنامج. بحثت طويلاً في الانترنت عن تثبيت خط من الاكسس فقط بدون مساعدة عامل خارجي ولكن لم اصل لنتيجة. اليوم بحمد الله قمت بحل المشكلة بإستخدام ( Visual .NET ) قمت بكتابة اداة بسيطة وظيفتها تثبيت الخط. يتم تمرير براميتر لها وهي بدورها ستقوم بتثبيته الدوال المستخدمة: AddFontResource CreateScalableFontResource ShellExecuteA للمزيد من المعلومات ، اضغط على اسم الدالة ارفقت لكم المصادر من MSDN شرح بسيط لمن لم يعرف ماذا اقصد بتثبيت الخط واستخدام الخط وانه لن يظهر في حال كان العميل لا يملكه. قمت بارفاق قاعدة بيانات لكم كـ مثال للشرح مع الخط المستخدم مع الاداة. شرح الاستعمال: يجب ان تكون الاداة ( SEMO_RegisterFont.exe ) هي والخط الذي سوف تستخدمه بجانب قاعدة البيانات. افتح برنامجك وضع فيه هذا الاجراء. Sub RegisterFont(nFont) Dim strExe As String Dim strArg As String strExe = CurrentProject.Path & "\" & "SEMO_RegisterFont.exe" strArg = "/SEMO/" & nFont ShellExecute 0, "runas", strExe, strArg, vbNullString, SW_SHOWNORMAL End Sub في الاستدعاء اي في الحدث Form_Current RegisterFont "DroidSansArabic.ttf" حيث ان الـ DroidSansArabic.ttf هو اسم الخط الذي قمنا بوضعه بجانب قاعدة البيانات ملاحظة مهمة جدا: في حال كان اسم الخط يتكون من اكثر من كلمة مثل ( Droid Sans Arabic.ttf ) قم بحذف المسافات بين كلمة واخرى بحيث يصبح ( DroidSansArabic.tts ) وستعمل قاعدة البيانات التي قمت بتصميمها بشكل رائع وبالخطوط التي قمت انت بأختيارها بدون الخوف من مشكلة عدم توفر الخطوط في جهاز العميل. الشرح حصري للمنتدى وغير موجود في الانترنت. لا تشكرني الا اذا وجدت انني استحق ذلك. تم بحمد الله حسنين RegisterFont_SEMO_Pa3x.rar

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

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

فى المرفق إستعلام لمعرفة الآسكى كود لأى حرف أو رقم أو علامة على لوحة المفاتيح AsciCod.accdb

ليس اسم الدولة اللتي توجد فيها الآن بل تغير الى لغة تصميم البرنامج ، اذا اكسس عربي تغير لعربي واذا فرنسي تغير لفرنسي ... وهكذا

تم رفع هذا الكود فى مشاركة منفصله حتى لا ننسى هذه المشاركة طلب برنامج صادر ووارد تم ارفاق ملف الموضوع من الفاضل _ أ / أبو حنــــين و لا تنسونا من صالح الدعاء الصادر و الوار-3.rar

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

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

اليك بعض الإضافات سيتم ادخال حركة المعدات للموظفين بالنموذج الفرعي ولاضافة معدات جديدة وموظفين جدد يتم ذلك من النموذج الرئيسي في انتظارك dbsafetyequipmentstore.rar