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

بالخدمة استاذي العزيز هذان ملفان الاول فيه اختصار بسيط للاكواد والثاني مبني على استعلام لكن الافضل التحقق من النتائج وان شاء الله صحيحة 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

السلام عليكم ورحمة الله استخدم هذا الكود Sub UnhideSheets() Dim Sh As Worksheet For Each Sh In Worksheets Sh.Visible = xlSheetVisible Next End Sub

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

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

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

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

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

نعم اخي الكريم كلامك صحيح توضع بالحقل الاخضر يبدوا انك اخترت الدالة الاولى تحياتي New D Report.rar

ربنا يزيدك من علمه 100/100

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

وعليكم السلام-لك ما طلبت 1مرتب.xlsx

جرب هذا الكود 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

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

اخي العزيز اذا كانت المشكلة لتقرير الطباعة ممكن حل مسالة التسلسل في التقرير ببساطة بجعل قيمة الحقل =1 زمن خصائص الحقل - بيانات- اجعل المجموع التراكمي = شامل ستجد ان التسلسل مضبوط حتى لو حذفت سجل اما اذا كان عندك جدول غير مرتبط بعلاقة مع جدول اخر ممكن حل المسالة بجعل حقل التسلسل رقم واستخدام دالة dmax في القيمة الافتراضية للحقل من خلال النموذج المرتبط بالجدول او من خلال الاستعلام . انظر للفيديو من خلال الرابط https://www.youtube.com/watch?v=z6aJXJWPAZg اما اذا كان نريد ارجاع التسلسل كما كان قبل الحذف بصورة رسميىة انظر لرابط الفيديو ومن ثم قم بضعط واصلاح قاعدة البيانات. https://www.youtube.com/watch?v=zV_ih0djTcw تحياتي

السلام عليكم .المعذره لم استطع تحميل ملفك المرفق عموما ..ضع الكود التالي في حدث الورقة المطلوبه ويمكن لك التحكم في المدى بين علامتي "" Private Sub Worksheet_Activate() ScrollArea = "A1:N100" End Sub

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

اذا كان ما فهمته صحيح المطلوب في هذا الملف Oujour.xlsx

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

ان لم يعجبك هذا فيمكنك متابعة هذا الموقع Generating QR Code barcodes from cells in Excel using VBA and Bytescout BarCode SDK

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

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

تفضل..ببساطة كل ما عليك هو تحميل هذا النوع من الخط وستجد ما تريد 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

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

جرب هذا test1.accdb

السلام عليكم, في السابق كنت استخدم خطوط معينة في برامجي وعند اعطاء البرنامج للعميل لاتظهر الخطوط التي قمت باستخدامها بل يظهر بمكانها الخط ( 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

جرب هذا الملف (بدون يوزر فورم) انا شخصياً لا احب التعامل مع يوزر فورم و مشاكله sader.rar

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

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

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

تفضل على السريع test11.rar

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