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

مشاركة مع اخي @king5star واستاذي القدير @أبو عبدالله الحلوانى الفكرة باختصار لاداعي لتغيير تنسيق الحقل الى 0000 وايضا لاداعي لوضع قناع ادخال للحقل ( اكثر خاصية اتجنبها ) وبالتالي نتحكم بمدخلات الحقل وتنسيقها عن طريق كود بسيط في حدث بعد التحديث لحقل رقم If Not IsNumeric([رقم]) Or Len([رقم]) > 4 Then MsgBox "هذا الحقل رقمي فقط وبعدد 4 ارقم" Me.رقم = "" Else Me.رقم = Format([رقم], "0000") End If اذا اردنا ارقام اكثر نغير رقم 4 الى اي رقم اكبر وكذلك نضع اصفار في السطر الخامس بنفس عدد الرقم في السطر الاول الملف مرفق الأرقام.accdb

ربما هذا ما تريده .... جرب واعلمنا بالنتيجة ؟؟؟؟ مثال اوفيسنا القيم الافتراضية (1).accdb

ومن الممكن استخدام الوحدة النمطية الاتيه فقمت بتصميمها لاجلك ! Public Function ZeroComplete(ZCount As Integer, NumValue As String) As String ' ___ _ ___ _ __ _ ___ _ _ ' | \ (_) ___ | _ ) _ _ | |/ / __ _ _ _ (_) _ __ | __| | | | |_ ___ ___ ___ ___ _ _ _ _ ' | |) | | | (_-< | _ \ | || | | ' < / _` | | '_| | | | ' \ | _| | | | ' \ / _ \ (_-< (_-< / -_) | ' \ | || | ' |___/ |_| /__/ |___/ \_, | |_|\_\ \__,_| |_| |_| |_|_|_| |___| |_| |_||_| \___/ /__/ /__/ \___| |_||_| \_, | ' |__/ |__/ ' _ ___ __ _ ___ ____ ____ ___ ____ ____ _ ___ _ ' _| |_ |_ ) / \ / | |_ ) |__ | |__ | ( _ ) |__ | |__ | / | | __| / | ' |_ _| / / | () | | | / / / / / / / _ \ / / / / | | |__ \ | | ' |_| /___| \__/ |_| /___| /_/ /_/ \___/ /_/ /_/ |_| |___/ |_| ' 'ZCount =عدد الاصفار المطلوبة 'NumValue = النص المراد استكمالة باصفار 'ZeroComplete = القيمة الاخيرة بعد التعديل ' ' Dim L_NumValue As Integer, Sub_Count As Integer L_NumValue = Len(NumValue) Sub_Count = ZCount - L_NumValue If Sub_Count < 0 Then MsgBox "ان طول عدد الاصفار المراد تكميلها أصغر من حجم الرقم برجاء التأكد من طول الرمز ." Else ZeroComplete = String(Sub_Count, "0") & NumValue End If End Function ولاستدعائها قم بالاتي : Private Sub txt1_AfterUpdate() txt1 = ZeroComplete(5, Me.txt1) End Sub ***** ملحوظة اخيره يجب ان يكون نوع الحقل نصي او text

تفضل أخي الكريم خط السير 2021 (1).rar

هل هذا ماتريده .....

اهم الاختلافات : اسماء المخازن في الكمبولست هي التر تظهر في التقرير يمكن تعديل مسميات المخازن من خلال الجدول أنظر الصور

طيب شوف المرفق هذا ربما اكثر احترافية ... __DATA144 - kanory.mdb

تفضل .................. __DATA144 - kanory.mdb

هل هذا ما تريد ؟؟؟؟؟

اخي الكريم هل طبق ما في هذه المشاركة للعلم ان التقرير والكود اساسا اعتماده على الارقام .... يعني لو حذفت هذه الارقام يختل الكود وطريقة ظهور البيانات في التقرير وهذا يعيدنا للمربع الاول للسؤال .... 😅

استبدلها بهذا ... ="مستودع"

البداية فقط لاول نطاقين من AE7 الى AE25 ثم تتابع الى باقي النطاقات كل نطاق حسب المعادلة المناسبة Sub From_Tornula_To_Vba() Const Ro = 23 With Sheets("Sheet1") .Range("AE7:AE" & Ro).Formula = _ "=IF(AND(ISNUMBER(I7),ISNUMBER(K7)),G7,"""")" .Range("AF7:AF" & Ro).Formula = _ "=IF(AND(ISNUMBER(I7),ISNUMBER(K7)),M7,"""")" .Range("AE7:AF" & Ro).Value = _ .Range("AE7:AF" & Ro).Value End With ''''''وهكذا الى نهاية النطاق End Sub من اجل الـــ SUMPRODUCT هذا الكود Option Explicit Sub From_SUMPRODUCT_To_Vba() Dim My_formula$, i As Byte, arr() My_formula = "=SUMPRODUCT(($BN$7:$BN$23=My_Cel)*($BP$7:$BP$23))+" My_formula = My_formula & "SUMPRODUCT(($BQ$7:$BQ$23=My_Cel)*($BO$7:$BO$23))" arr = Array("CA9", "CA13", "CA17") For i = LBound(arr) To UBound(arr) With Sheets("Sheet1").Range("CC9").Offset(4 * i) .Formula = _ Replace(My_formula, "My_Cel", arr(i)) .Value = .Value End With Next i End Sub

Range("C3").Select ActiveCell.FormulaR1C1 = _ "=IF(AND(ISNUMBER(R[4]C[6]),ISNUMBER(R[4]C[8])),R[4]C[4],"""")" Range("C4").Select ActiveCell.FormulaR1C1 = _ "=IF(AND(ISNUMBER(R[3]C[6]),ISNUMBER(R[3]C[8]),R[3]C[6]>R[3]C[8]),R[3]C[4],"""")" Range("C5").Select ActiveCell.FormulaR1C1 = _ "=SUMPRODUCT((R7C66:R23C66=R[4]C[76])*(R7C67:R23C67))+SUMPRODUCT((R7C69:R23C69=R[4]C[76])*(R7C68:R23C68))"

ملف رائع بارك الله بك عندي اقتراح /نفس العمل لكن بمعادلة Missing Numbers.xlsx

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

مرحبا بكم جميعًا أيها الأحبة الكرام ولله الحمد والمنة تم الانتهاء من عمل كل اللازم في الملف وأشكر أخي نزار على وقفته معي فقد فتح الله تعالى علي بعد محاولات عديدة استغرقت ساعات كثيرة. وهذا الملف بين أيديكم نسأل الله أن ينفع بنا. كشف الغياب - النهائي.xlsm

جرب هذا النموذج (فقط اضغط على الزر Sort Please) Option Explicit Sub Creezy_Sort() Dim arr, itm, k% Dim txt Dim Col As Object Set Col = CreateObject("System.Collections.Sortedlist") With Sheets("Salim") arr = .Range("A1").CurrentRegion arr = Application.Transpose(arr) .Range("C1").CurrentRegion.ClearContents For Each itm In arr If InStr(itm, ":") Then txt = Split(itm, ":") If UBound(txt) = 1 Then Col.Add CStr(txt(1)), CStr(txt(0)) End If End If Next itm If Col.Count Then For k = 0 To Col.Count - 1 .Cells(1, 3).Offset(k) = _ Col.GetByIndex(k) & ":" & Col.GetKey(k) Next End If End With End Sub الملف مرفق ellatef.xlsm

جميعا بإذن الله أستاذ علي

ارفع نسخة من البرنامج لكي نستفيد منه اذا تكرمت

جرب اخي المرفق التالي وفي انتظار ردك تقبل خالص تحياتي نسخ شيتات معينة لملف آخر بدون المعادلات وتسميته بتاريخ اليوم.rar

و لتحويل المعادلات لارفام نضيف جزء جديد Sub SplitSpecificSheet_onefile() Dim xPath As String xPath = Application.ActiveWorkbook.Path Application.ScreenUpdating = False Application.DisplayAlerts = False Sheets(Array("Sheet1", "Sheet2")).Select Sheets(Array("Sheet1", "Sheet2")).Copy For k = 1 To ActiveWorkbook.Sheets.Count ActiveWorkbook.Sheets(k).Activate Cells.Select Application.CutCopyMode = False Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Next k Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & "officena" & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled Application.ActiveWorkbook.Close False Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub

كود لنسخ ملف الاكسل كل 30 يوما و يتم تخزين الملف الجديد في المجلد Monthly Reports مع تاريخ الانشاء و اللوقت عملت مثال لتتضح الطريقة كل ماعليك فعله هو وضع الاجراء CheckAndCopyThisWB في حدث فتح الملف Sub CheckAndCopyThisWB() ' المجلد الذي سيتم تخزين الملفات فيه Const DestDir As String = "\Monthly Reports\" ' عنوان الخلية التي تحتوي على اخر تاريخ تم نسخ الملف Const LastCopyCell As String = "B1" ' اسم الملف بدون امتداد Dim WBName As String ' امتداد الملف بدون الاسم Dim WBExtension As String ' المسار كاملا لملف المصدر Dim SourceFile As String ' المسار كاملا للملف الجديد Dim DestFile As String ' تأكد انه مرة 30 يوما على اخر عملية نسخ او ان الملف ينسخ للمرة الاولى If Sheets("LOG").Range(LastCopyCell).Value = "" Or DateAdd("d", 1, Sheets("LOG").Range(LastCopyCell).Value) <= Date Then WBName = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - (Len(ThisWorkbook.Name) - InStrRev(ThisWorkbook.Name, ".") + 1)) WBExtension = Mid(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, "."), 7) SourceFile = """" & ThisWorkbook.FullName & """" DestFile = """" & ThisWorkbook.Path & DestDir & WBName & Format(Now(), "dd-mmm-yy-h-mm;@") & WBExtension & """" ' انسخ الملف Shell "CMD /C COPY /-Y " & SourceFile & " " & DestFile, vbHide ' حدث تاريخ اخر عملية نسخ Sheets("LOG").Range(LastCopyCell).Value = Date End If End Sub Check and Copy Workbook.zip

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

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

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

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

بسم الله الرحمن الرحيم الاخوة الافاضل لدي استعلام عن موظفين (لا على التعين) عند طلب طباعة تقرير تفاصيل معينة بواسطة اسم موظف يتم الطباعة عادي اذا كان هناك معلومات حول ذلك الموظف الذي تم اختيارة وكن حينما يكون اسم الموظف لايوجد لدية اية تفاصيل فيتم طباعة التقرير Error# فكيف يتم جعل الاستعلام يعطي خانة فارغة في حال عدم وجود اي معلومة عن الموظف المستعلم عنة لطباعتة . وشكراً

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

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

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

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

السلام عليكم ورحمة الله وبركاته أخواني الكرام كما هو معلوم عندما تقوم ببناء قاعدة بيانات ، لا يمكن أن تتوقع كل الإستعلامات أو المعايير التي سوف يطلبها المستخدم ، حتى ولو كان لديك مهارة في ذلك ، حيث يمكن أن يكون الأمر مملاً عندما تقوم بإستبدال المعايير في كل مره. على كل حال الملف المرفق ان شاء الله يوفر عليكم ذلك الجهد :) والله الموفق. AccessAndSQL.rar