Foksh

جزااكم الله خيراً ، فعلاً تم تشغيل البرنامج بعد تسجيل الملف ، وللفائدة بطريقة التسجيل :- افتح CMD موجه الأوامر كمسؤول ، تأكد من نسخ الملف المرفق "MSSTDFMT.DLL" في مشاركة معلمي أبو خليل الى المسار :- C:\Windows\SysWOW64 اذا كان الويندوز 64 . ثم اكتب الأمر التالي للتسجيل :- regsvr32 "C:\Windows\SysWOW64\MSSTDFMT.DLL" حتى تحصل على النتيجة التالية : صورة البرنامج :- أجدت فيما طرحت ، وأبدعت معلمي الفاضل

زاد الله فضلك ، وأشكرك اهتمامك معلمي الفاضل ، ولكن للأسف لم تكتمل اللحظة 😥

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

وعليكم السلام ورحمة الله وبركاته ,, بعد فهم الموضوع ، هذه محاولتي البسيطة ، حيث بعد انشاء النموذج والتقرير ، وإضافة عنصر CheckBox جنب كل حقل ترغب بلإظهاره أو لا ، ومن خلال الزر في النموذج اعتمدت على TempVars لحفظ قيمة كل CheckBox ثم فتح التقرير من خلال الكود التالي في الزر :- Private Sub btn_PreviewReport_Click() TempVars("SelectedEmpCode") = Me.Tx_Emp.Column(0) TempVars("Show_NationalID") = Me.chk_NationalID.Value TempVars("Show_Emp_BirthDate") = Me.chk_Emp_BirthDate.Value TempVars("Show_Emp_Phone") = Me.chk_Emp_Phone.Value TempVars("Show_Qualification") = Me.chk_Qualification.Value TempVars("Show_Graduation") = Me.chk_Graduation.Value TempVars("Show_Emp_Address") = Me.chk_Emp_Address.Value TempVars("Show_Appointment") = Me.chk_Appointment.Value TempVars("Show_InsuranceID") = Me.chk_InsuranceID.Value TempVars("Show_JobDesc") = Me.chk_JobDesc.Value TempVars("Show_Department") = Me.chk_Department.Value TempVars("Show_Salary") = Me.chk_Salary.Value TempVars("Show_InsuranceFee") = Me.chk_InsuranceFee.Value DoCmd.OpenReport "Rpt_EmployeeStatement", acViewPreview End Sub الآن وفي التقرير ، استخدمت الـ Tag لتحديد ارتفاع العناصر جميعها بحيث تم تحديده 400 ، ومن هنا تم الاعتماد على الدالة :- Private Sub AdjustFieldVisibility(ctrl As Control, showField As Boolean) If showField Then ctrl.Height = Val(ctrl.Tag) ctrl.Visible = True Else ctrl.Visible = False ctrl.Height = 0 End If End Sub بإخفاء وتصغير ارتفاع العناصر التي لا نرغب بها .. وفي مصدر سجلات التقرير ، استخدم الاستعلام التالي :- SELECT * FROM tbl_Employees WHERE (((tbl_Employees.[Emp_Code])=[TempVars]![SelectedEmpCode])); وفي الحدث عند التنسيق ، استخدمت الكود التالي لاستدعاء الدالة السابقة وتطبيق الاخفاء على العناصر التي لا نريدها . Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer) AdjustFieldVisibility Me.NationalID, TempVars!Show_NationalID AdjustFieldVisibility Me.Emp_BirthDate, TempVars!Show_Emp_BirthDate AdjustFieldVisibility Me.Emp_Phone, TempVars!Show_Emp_Phone AdjustFieldVisibility Me.Qualification, TempVars!Show_Qualification AdjustFieldVisibility Me.Graduation, TempVars!Show_Graduation AdjustFieldVisibility Me.Emp_Address, TempVars!Show_Emp_Address AdjustFieldVisibility Me.Appointment, TempVars!Show_Appointment AdjustFieldVisibility Me.InsuranceID, TempVars!Show_InsuranceID AdjustFieldVisibility Me.JobDesc, TempVars!Show_JobDesc AdjustFieldVisibility Me.Department, TempVars!Show_Department AdjustFieldVisibility Me.Salary, TempVars!Show_Salary AdjustFieldVisibility Me.InsuranceFee, TempVars!Show_InsuranceFee End Sub طبعاً طرق كثيرة قد تحقق لك المطلوب ، ولكن هذه رؤيتي وفي النهاية ، الملف بعد التعديل :- بيان حاله.accdb

جزاك الله عنا كل الخير .. انا اعجبتني الفكرة ، وقد تكون إضافة مميزة لبرنامج عيادات نسائية

وعليكم السلام ورحمة الله وبركاته ،، أكثر الله من هداياكم وعطاياكم معلمنا الفاضل .. وجزاكم الله كل الخير يبدو أنني لست من المحظوظين لأن النسخة 32 ، وانا عندي الإصدار 2016 - 64 😥

أحسنتم أخي الأستاذ @محمد هشام. ، ما تفضلتم به صحيح ولا شك فيه ، خصوصاً أن الدوال التي ذكرتها تعود بقيمة رقمية يتم تحويل التاريخ أو الوقت فيها الى رقم يفهمه اكسل أو آكسيس ، مما سيضطرني كمستخدم لتحويل تنسيق الخلية الى نوع تاريخ ( على سبيل المثال ) ليتم اظهار القيمة الرقمية على شكل تاريخ .. وعلى سبيل المثال ، قمت بتجربة بسيطة للتحقق مما اذا كان الناتج من فكرتي يتم قراءته كتاريخ أم لا ، باستخدام المعادلة :- = DATEDIF(M2, TODAY(), "y") & " سنوات و " & DATEDIF(M2, TODAY(), "ym") & " أشهر و " & DATEDIF(M2, TODAY(), "md") & " أيام" وطبعاً هي لكسب المعلومة ليس أكثر ( ) ، فقد كانت النتيجة صحيحة عند التعامل مع القيمة كقيمة تاريخ ، ( شريطة انني لم أغير تنسيق الخلية الى تاريخ ) .. ولكن ما تفضلتم به يثري معلوماتي في أكسل . فشكراً لكم أخي الفاضل رحابة صدركم ، وشرحكم الجميل

وعليكم السلام ورحمة الله وبركاته ., أخي الكريم ، تستطيع فعل هذا باستخدام الجملة التالية :- =TEXT(L2, "mmm dd, yyyy") وهذا مرفق لكيفية استخدامها وتنفيذها على جميع الخلايا التي تريدها .. تمديد.xlsx

في التحديث الجديد ، تم إضافة ميزات جديدة . بحيث :- تم دعم الحقول المدمجة في جوجل شيت . تم إضافة ميزة التحكم بتحديد صف العناوين ( للأوراق التي تدعم ترويسة ) في جوجل شيت . إصلاح بعض الأفكار السابقة للتعامل بشكل أسهل وأسرع عند الإستيراد من جوجل شيت . * ملاحظة :- لا ننصح باستخدام تسميات عربية للأوراق في جوجل شيت ( بسبب تغير سياسة جوجل شيت المتنقلة بين فترة وأخرى في إعدادات الـ API ) Excel Importor V3.0.accdb

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

وعليكم السلام ورحمة الله تعالى وبركاته.. الق نظرة على هذا الموضوع

عمل جميل ورائع ، ويعبر عن روعة صاحبه وأفكاره معلمنا الفاضل @jjafferr 😇 لم أقرأ هذا الموضوع سابقاً ، وأعتقد أن اليوم كان من حسن حظي اني تابعته

أخي @jo_2010 ، لاحظ أننا في الحلول التي قدمناها لك لم نعتمد على الصورة التي قمت بإضافتها الى الملف المرفق ، بل اعتمدنا على عنصر صورة واحد ومربع نص واحد = مصدر لعنصر الصورة بحيث في جملة شرطية مركبة ، اذا كانت قيمة مربع النص = "المختبر" يصبح مسار الصورة في عنصر الصورة = الصورة M.Png الموجودة داخل المجلد Images الموجود بجانب قاعدة البيانات . وإذا لم يتحقق الشرط يصبح مصدره الصورة BB.Png في نفس المسار والمجلد . وإلا كشرط ثالث اذا كانت القيمة فارغة = Null يصبح مصدر عنصر الصورة = الصورة الغير موجودة باسم Foksh افتراضاً .

في الملف الذي ارسلته لك ؟؟؟؟

Private Sub LABO_Click() DoCmd.RunSQL "UPDATE Tbl_Lab_All SET External_lab = Null " & _ "WHERE PCode = [ID];" Me.Refresh Me.Code_Kind.SetFocus End Sub

أخي الفاضل @abdelazizladour ، صدقني لو أنك اجتهدت على توضيح المطلوب وشرحه شرحاً وافياً كافياً لوجدت الكثير من أيدي المساعدة والحلول . نرجو منك الإلتزام بقوانين المنتدى من خلال الدلالة على المشكلة من خلال العنوان ، والتوضيح في الشرح بشكل يسمح للآخرين فهم ما تحاول قوله وتنفيذه وإيجاد حل له .

وعليكم السلام ورحمة الله وبركاته .. للأسف لا توجد معادلة مباشرة في اكسل ( على حد علمي ) تقوم تلقائياً بتجربة قيم مختلفة حتى يتحقق شرط معين ، ولكن يمكنك تحقيق هذا باستخدام أداتين رئيستين :- استخدام أداة "Goal Seek" ( البحث عن الهدف ) ، وهنا مجموعة فيديوهات قد تفيك بالتعرف على هذه الإداة . استخدام "Solver" ( وهي أكثر فاعلية وأكثر قوة ) . وهذا رابط فيديو لشرح بسيط قد يفيدك . وهذا رابط فيديو لطريقة تفعيل Solver . ومتأكد أنك ستجد من خبراء هذا القسم الكبير ومعلميه الفائدة المباشرة من خلال تجاربهم .

وعليكم السلام ورحمة الله وبركاته ،، هي فعلاً أحد المشاكل التي يقع فيها مصمم البرنامج عندما لا تكون لديه معلومة حول فكرة ارفاق الملفات كمرفقات بدلا من استعمال المسارات للملفات المرفقة . طبعاً في مشاركة لمعلمنا الأستاذ @jjafferr في هذا الموضوع هنا ، أشار إلى أنه :- "في الاوفيس M365 تم رفع الطاقة التخزينية الى 4 جيجا بشرط يكون الوندوز 64 بت" . طبعاً بعد وقوعك في هذه المشكلة ، سيترتب عليك جهداً كبيراً من العمل ، بحيث ستضطر الى تفريغ الملفات المرفقة من قاعدة البيانات الحالية الى مجلدات خارجية أولاً ( من خلال كود ) ، ثم تعديل نوع الحقل من مرفقات الى نصي للإستبدال بمسار الملف لكل سجل ، ( قد تواجه مشكلة لاحقة في الضرورة الى إتاحة مساحة قليلة لإضافة نموذج يتم من خلاله العمل على افراغ كافة المرفقات الى مجلدات من خلال كود مخصص ، يعتمد على تحديد اسم الجدول واسم الحقل ، وطريقة افراغ المرفقات الى مجلد محدد بحيث يكون معرف لرقم العميل او اسم المستخدم .... إلخ ) وهذا طبعاً بنظري سيأخذ وقت طويلاً نسبياً بسبب حجم القاعدة الحالي وعدد الملفات التراكمي . العديد من الأفكار يمكن تنفيذها ولكنك ستحتاج وقتاً ( ليس تحطيم للمعنويات بقدر ما هو حافز أنه يمكنك افراغ القاعدة وإعادة تشغيلها بطريقة علمية وممكنة ) .

مشاركة مع الأساتذة ، دون الحاجة لإستعلام .. JO_Lab.zip

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

أجدتم بما تفضلتم أخي الفاضل @محمد هشام. ، ومعلوماتك فادتني بشكل واسع في هذا المجال .. أشكر لكم حسن إصغائكم لي على امل أن لا نكون قد خرجنا عن محور الموضوع ( لعدم تشتت القارئ لاحقاً ) .

بارك الله بكم جميعاً أخي الأستاذ @محمد هشام. ، وأثابكم الله على ما قدمتم .. واسمح لي بسؤال متفرع فيما يخص الكود الذي طرحته .. هل لك أن تشرح لي حاجتنا لـ (COUNTIF و SUBTOTAL) ؟🤗؟ ( من باب كسب المعلومة ) وهل اعتمدت فعلاً على مصفوفات فرعية ؟؟ (ReDim a() ومن باب المشاركة وبما أنني قد أخطأت في ماركتي الأولى سابقاً 😅 ، سأقدم فكرتي والتي لا اعتقد انها بكفاءة أفكاركم أهل الديار 🤗 . Sub CopyDataToWorksheets() Dim wsMain As Worksheet, wsNew As Worksheet Dim dict As Object, dataArray As Variant, formatsArray As Variant Dim i As Long, lastRow As Long, targetRow As Long Dim sheetName As String, startTime As Double: startTime = Timer Const ROW_HEIGHT As Double = 20.25 With Application .ScreenUpdating = False .Calculation = xlCalculationManual .EnableEvents = False .DisplayAlerts = False .StatusBar = "جاري معالجة البيانات مع الحفاظ على التنسيقات" End With On Error GoTo ErrorHandler Set wsMain = ThisWorkbook.Sheets("معاشات") Set dict = CreateObject("Scripting.Dictionary") lastRow = wsMain.Cells(wsMain.Rows.Count, "A").End(xlUp).Row If lastRow < 5 Then GoTo CleanUp dataArray = wsMain.Range("A5:M" & lastRow).Value formatsArray = wsMain.Range("A1:M" & lastRow).FormatConditions For i = 1 To UBound(dataArray, 1) sheetName = CleanSheetName(Trim(dataArray(i, 5))) If sheetName <> "" Then dict(sheetName) = Empty Next i Application.DisplayAlerts = False For Each wsNew In ThisWorkbook.Worksheets If Not wsNew Is wsMain Then If dict.exists(wsNew.Name) Then wsNew.Delete End If Next wsNew Application.DisplayAlerts = True For Each sheetName In dict.keys Set wsNew = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) wsNew.Name = sheetName wsNew.DisplayRightToLeft = True wsMain.Range("A1:M4").Copy wsNew.Range("A1").PasteSpecial Paste:=xlPasteAll Application.CutCopyMode = False targetRow = 5 For i = 1 To UBound(dataArray, 1) If CleanSheetName(Trim(dataArray(i, 5))) = sheetName Then wsNew.Range("A" & targetRow & ":M" & targetRow).Value = Application.Index(dataArray, i, Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13)) targetRow = targetRow + 1 End If Next i If Not IsEmpty(formatsArray) Then On Error Resume Next wsMain.Range("A5:M" & lastRow).FormatConditions.Copy wsNew.Range("A5:M" & targetRow - 1) On Error GoTo 0 End If With wsNew .Rows.RowHeight = ROW_HEIGHT For i = 1 To 13 .Columns(i).ColumnWidth = wsMain.Columns(i).ColumnWidth Next i .Range("E3").Font.Name = "Arial" End With Next sheetName wsMain.Range("E3").Font.Name = "Arial" wsMain.Activate CleanUp: With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic .EnableEvents = True .DisplayAlerts = True .StatusBar = False End With Debug.Print "تم الانتهاء في " & Format(Timer - startTime, "0.00") & " ثانية" Exit Sub ErrorHandler: MsgBox "حدث خطأ في السطر " & Erl & ": " & Err.Description, vbCritical + vbMsgBoxRight,"" Resume CleanUp End Sub Function CleanSheetName(sName As String) As String Dim illegalChars As Variant, char As Variant illegalChars = Array("\", "/", ":", "?", "*", "[", "]") CleanSheetName = sName For Each char In illegalChars CleanSheetName = Replace(CleanSheetName, char, "_") Next char If Len(CleanSheetName) > 31 Then CleanSheetName = Left(CleanSheetName, 31) End If End Function

تم تعديل الاستعلام بشكل صحيح ، في المشاركة السابقة

أخي جو الخطأ منك ، حيث في استعلامك يتم تحديث حقل مختلف في جدول مختلف عن الحقل الموجود في الاستعلام مصدر النموذج الفرعي انظر التعديل الصحيح :- DoCmd.RunSQL "UPDATE Tbl_Lab_All SET External_lab = 'المختبر' " & _ "WHERE PCode = [ID];" وقم بإيقاف السطر Me.External_lab = "المختبر"