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

استبدل الكود لديك بهذا الكود واعلمني بالنتيجة ...... On Error GoTo HandleErr On Error Resume Next Dim rs As Object If Not IsNull([PicFile2]) Then [imgPicture].Picture = [PicFile2] SysCmd acSysCmdSetStatus, "Image: '" & [PicFile2] & "'." Else [imgPicture].Picture = "" SysCmd acSysCmdClearStatus End If Exit Sub HandleErr: If Err = 2220 Then [imgPicture].Picture = "" SysCmd acSysCmdSetStatus, "Can't open image: '" & [PicFile2] & "'" Else MsgBox Err.Description, vbExclamation End If

ربما هذا يفيدك ويؤدي الغرض .......... listbox.accdb

جرب هذا الماكرو Option Explicit Sub sorted_liste() Dim SL1 As Object Dim xItem Dim rg As Range, c As Range Dim i As Long Dim X As Long Dim arr() Dim y Range("c1").CurrentRegion.ClearContents Set SL1 = CreateObject("System.Collections.ArrayList") Set rg = Sheets("salim").Cells(1).CurrentRegion For Each c In rg y = SL1.Contains(c) X = Application.CountIf(rg, c) If X > 1 And y = False Then If Not SL1.Contains(c.Value) Then SL1.Add (c.Value) End If Next arr = SL1.ToArray Range("c1").Resize(UBound(arr) + 1) = Application.Transpose(arr) End Sub الملف مرفق فلترة.xlsm

كل شيء ممكن وينجح مع الإصرار ولكن أكره الكلام النظري فائدته قليلة جدا وحسب فهمي للمطلوب يمكن تصميم النموذج كما تشاء مع مراعاة أن جميع أسماء الحقول في قاعدة البيانات كلها غير ممكنة نظريا وعند اختيار الأعمدة يتم تجميع نص الاستعلام بلغة sql وبناء تقرير جديد بناء على الاستعلام بهذه الدالة المعرفة Function CreateDynamicReport(strSQL As String) Dim db As DAO.database ' database object Dim rs As DAO.Recordset ' recordset object Dim fld As DAO.Field ' recordset field Dim txtNew As Access.TextBox ' textbox control Dim lblNew As Access.Label ' label control Dim rpt As Report ' hold report object Dim lngTop As Long ' holds top value of control position Dim lngLeft As Long ' holds left value of controls position Dim title As String 'holds title of report 'set the title title = "Title for the Report" ' initialise position variables lngLeft = 0 lngTop = 0 'Create the report Set rpt = CreateReport ' set properties of the Report With rpt .Width = 8500 .RecordSource = strSQL .Caption = title End With ' Open SQL query as a recordset Set db = CurrentDb Set rs = db.OpenRecordset(strSQL) ' Create Label Title Set lblNew = CreateReportControl(rpt.Name, acLabel, _ acPageHeader, , "Title", 0, 0) lblNew.FontBold = True lblNew.FontSize = 12 lblNew.SizeToFit ' Create corresponding label and text box controls for each field. For Each fld In rs.Fields ' Create new text box control and size to fit data. Set txtNew = CreateReportControl(rpt.Name, acTextBox, _ acDetail, , fld.Name, lngLeft + 1500, lngTop) txtNew.SizeToFit ' Create new label control and size to fit data. Set lblNew = CreateReportControl(rpt.Name, acLabel, acDetail, _ txtNew.Name, fld.Name, lngLeft, lngTop, 1400, txtNew.Height) lblNew.SizeToFit ' Increment top value for next control lngTop = lngTop + txtNew.Height + 25 Next ' Create datestamp in Footer Set lblNew = CreateReportControl(rpt.Name, acLabel, _ acPageFooter, , Now(), 0, 0) ' Create page numbering on footer Set txtNew = CreateReportControl(rpt.Name, acTextBox, _ acPageFooter, , "='Page ' & [Page] & ' of ' & [Pages]", rpt.Width - 1000, 0) txtNew.SizeToFit ' Open new report. DoCmd.OpenReport rpt.Name, acViewPreview 'reset all objects rs.Close Set rs = Nothing Set rpt = Nothing Set db = Nothing End Function بالتوفيق

وعليكم السلام ...... لكن ماهو الهدف ( هل مجرد عرض أم اختيار من تلك البيانات ) ؟؟؟؟؟

بسم الله الرحمن الرحيم والصلاة والسلام على سيد المرسلين إخوتي وأخواتي الأعزاء ابدأ اليوم شرحا تفصلينا لتحليل (بسيط) وشرح موسع قدر الإمكان لبرنامج هيكل تنظيمي لشركة ، حيث سأقوم إن شاء الله ببناء قاعدة البيانات وإنشاء الجداول وشرحها وبناء علاقاتها وبناء النماذج و إنشاء الاستعلامات بأنواعها والتقارير وما يتيسر من الماكرو والتقارير ، كل ذلك بالشرح و الصور ، خطوة بخطوة . هذا جهد واجتهاد أوجه فيه النية لوجه الله تعالى ، ساعيا لطلب العلم وابغي نشر وتوضيح ما علمني ربي ، آملا أن تعم الفائدة . موضوع اطرحه للفائدة راجيا التلطف بالمرور و الاطلاع و إتحافي بآرائكم وإرشاداتكم و أسئلتكم . البرنامج عامل في شركتي منذ انجازي له ، وأظن انه يحقق غاياته المرجوة منه ويوفر قاعدة معلومات جيدة عن الهيكل التنظيمي للشركة لاطلاع المستخدمين المعنيين ويحدد صلاحيات جميع المستخدمين بدرجاتهم المختلفة ، جعلته مرنا قدر الإمكان حيث يصلح لجميع الشركات مهما كانت اختصاصاتها و أعمالها، ومهما كان حجمها وعدد منتسبيها . باسم الله وهدايته نصول ونجول ، اللهم يسر لي أمري وافكك عقدة من لساني يفقهوا قولي . نبدأ بتوضيح الفكرة من البرنامج حيث نسعى هنا لضبط وتوضيح معالم الهيكل التنظيمي لشركتنا ، حيث أن هذه الشركة تحوى هرما وظيفيا يعتليه مدير عام ويقوم على مجموعة من الموظفين ، مرورا بمجموعة من المدراء و رؤساء الأقسام . هذا بالنسبة للأشخاص ، ويرتبط بهم مسميات وظيفية ومهام وواجبات ، وهذه تمارس ضمن ادارات وأقسام ، وهذا كله مدرك ومعروف ومألوف ، فالفكرة سهلة ولا تحتاج لخبرة ( تخصصية ) في التحليل والفهم ، وهي موضحة في الرسم التالي ( الصورة 1 / الهيكل / الإدارات) والهيكل التنظيمي الذي سنعمل عليه يخص شركة للنقل الدولي و التخليص. ونفترض هنا أن تحليلنا للنظام مكتمل وتقاريره جاهزة بين أيدينا كمبرمجين ، وسأورد فحواه هنا وهناك أثناء التنفيذ و الشرح ، والله المستعان . نبدأ الآن بإنشاء قاعدة البيانات ، حيث نقوم بتشغيل الاكسيس بالضغط على الأيقونة الخاصة به على سطح المكتب . ثم ومن ملف نختار ( جديد ) ثم ( قاعدة بيانات جديدة ) ومن خلال نافذة خاصة يطلب منا اختيار اسم لقاعدة البيانات الجديدة ونختار الاسم المناسب (هيكل تنظيمي / الهيكل التنظيمي) ثم نختار إنشاء. ( الصورة 2 /انشاء ملف) فتظهر لنا نافذة قاعدة بياناتنا الجديدة تحتوي كائنات جديدة فارغة وهي (جداول) ( استعلامات) ( نماذج) ( تقارير) ( وحدات ماكرو) ( وحدات نمطية). ( الصورة 3 / قاعدة البيانات) ونبدأ هنا وحسب تحليل النظام والذي يتطلب إنشاء جدول الإدارات ، حيث نختار جداول ثم جديد حيث تظهر لنا نافذة جدول جديد ونختار هنا ( طريقة عرض التصميم ) ، وسوف نتعرض لاحقا لبقية الخيارات – ثم نختار موافق . ( الصورة 4 / جدول جديد) ( الصورة 5 / تصميم جدول) وفي خانة اسم الحقل نكتب الاسم الدال على الحقل و المعبر عنه ، ويفضل هنا أن نكتب الأسماء بالأحرف الانجليزية تجنبا لكثير من المشاكل اللاحقة ( كما يؤكد علينا كثير من أساتذتنا – وأخص بالذكر أستاذتنا الفاضلة زهرة ) ، ثم ننتقل لخانة نوع البيانات ونختار منها ما يناسب صفة نوع البيانات( نوع القيم) التي سنتعامل معها في هذا الحقل وهي واحد من : نص مذكرة رقم تاريخ/وقت عملة ترقيم تلقائي نعم/لا كائن OLE ارتباط تشعبي معالج بحث وانوه هنا إلى ضرورة دراسة هذه الأنواع وتفصيلاتها ولوازم استخدامها وإمكاناتها وطرق السيطرة عليها و الاستفادة منها ن حيث أن التعرض لتفاصيلها هنا قد يطيل الموضوع كثيرا . وعند اختيار أي من أنواع القيم هذه تظهر لدينا في منطقة خصائص الحقل مجموعة من الخيارات و الضوابط و الإمكانات التي تساعدنا للسيطرة على القيم التي ستخزن في هذا الحقل وضبطها حسب ما تقتضيه الغاية المبينة في تحليل النظام المعتبر ، دون مبالغة في التقييد أو التساهل فيه ( بلا إفراط أو تفريط) ( الصورة 6 / خصائص الحقل) ونضرب هنا مثل الحقل الذي سميناه ( الكود ) وهو كود الإدارات المميز لها ، وباعتباره قيمة مختارة تميز كل إدارة من الإدارات عن غيرها ، فلا يجوز إن تتكرر فنشترط في خاصية الفهرسة ( نعم / بدون تكرار) حتى لا نسمح لمدخل البيانات تكرار كود إدارة مستخدم مما يسبب مشكلة في تمييز الإدارات عن بعضها ، وسنتعرض لأهمية تفردها لاحقا . ولغايات اعتماد هذا الحقل كمفتاح رئيسي للجدول نقوم ومن شريط الأدوات القياسي نختار ( المفتاح ) ، وبذلك يصبح هذا الحقل مفتاحا للترقيم الاختياري . ( الصورة 7 / المفتاح) وفي خانة الوصف نشرح ما نجده مناسبا لتوصيف هذا الحقل و البيانات التي يحتويها. ثم نتابع نفس الخطوات للحقل الثاني وهو ( الإدارة) ، وعند الخروج من هذه النافذة يطلب منا اختيار اسم للجدول فنختار اسما دالا واضحا ( الإدارات ) ، ويعود بنا الاكسيس لنافذة قاعدة البيانات التي أصبحت تحتوي على جدول الإدارات ، وبهذا نكون قد أنشأنا أول جدول في قاعدة بياناتنا الجديدة ( الهيكل التنظيمي ). ونكرر نفس الخطوات السابقة لإنشاء جدولنا الثاني الأقسام . ولفتح الجدول ومشاهدة محتوياته أو العودة لوضع التصميم لإجراء أي تعديل نستخدم أزرار التنقل في نافذة قاعدة البيانات ( تصميم و فتح ) ( الصورة 8 / تصميم- فتح) ( الصورة 9 / فتح) نكتفي بهذا القدر اليوم آملا مروركم للتعليق على ما قدمت ، منتظرا آرائكم بخصوص الاستمرار أو .... مرفقا طيا الملف CLASS1 صدقوني هذا الشرح البسيط مرهق ( للتجهيز ) ونسأل الله ان يكون الأجر بقدر المشقة ، والله من وراء القصد ، وهو المستعان أخوكم نارت لبزو ( أبو آدم) CLASS1.rar 1.doc

اذا كان عندتا مجموعة من الارقام من واحد الى N ) N من اختيارك ) و يجب توزيع هذه الأرقام على جدول من M عامود ( M من اختيارك ابضاً) انظر الى الملف المرفق لمعرفة كيف يقوم الاكسل بفعل هذا الشيء الكود Option Explicit Sub CreateNumbers(rg As String, col_num As Long, max_num As Long) Dim n As Long Dim My_row As Long Dim My_col As Long ActiveSheet.Cells(6, 1).CurrentRegion.Clear For n = 0 To max_num - 1 My_row = n \ col_num My_col = n Mod col_num ActiveSheet.Range(rg).Offset(My_row, My_col) = n + 1 Next n End Sub '============================================== Sub give_numbers() Call CreateNumbers(Cells(6, 1).Address, [b2], [c2]) End Sub الملف مرفق Num_table.xlsm

السلام عليكم ورحمة الله وبركاته في المثال ما يغني عن المقال changePic.rar

تفضل اخي الكريم للازالة مسافة بين اسماء Function hr_Sps(MyText As String) As String Dim txt, txtA For Each txt In Split(MyText) If Len(txt) Then txtA = txtA & " " & txt Next hr_Sps = Trim(txtA) End Function ()Private Sub Cnm01_Click Dim DB As DAO.Database Dim rst As DAO.Recordset Set DB = CurrentDb Set rst = DB.OpenRecordset("table") rst.MoveFirst Do Until rst.EOF rst.Edit rst!Xname = hr_Sps(rst!Xname) rst.Update rst.MoveNext Loop MsgBox "تم تحديث بيانات بنجاح" End Sub و للمسافات زائدة استبدل سطر الرابع If Len(txt) Then txtA = txtA & " " & txt على If Len(txt) Then txtA = txtA & "" & txt واخيرا اضافة مكتبة

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

ببساطة انظر المرفق ......... Photo.rar

اخي الفاضل . الحقل الموجود في الجدول عندك بهذا الاسم PicFile٢ وليس PicFile اذا اردتها بهذا الاسم فغير الاسم الموجود في جدول البيانات واستخدم كودك السابق . تحياتي لك

بعد اذن اخي علي بدون شرط IF ( حيث ان دالة SUM تتجاهل النصوص) هذه المعادلة (Ctrl+Shift+Enter) =SUM(1*MID(A4,ROW(INDIRECT("1:"&LEN(A4))),1))

ان شاءالله تضبط @محمد عبد الشفيع اذا لم تصل الى حل ارسل لي اخر ملف قمت بالتعديل عليه

بارك الله فيكم جميعا بعد اذن الأخت الكريمة -ولإثراء الموضوع هذا حل أخر بمعادلات المصفوفة جريدرات.xlsx

@محمد عبد الشفيع اضف للكود اعلاه سطر اخير Me.requery وان شاءالله تنحل

تم الحل عن طريق الأستاذ / محمد صالح في المشاركة هذه 👈 حل المشكلة

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

بارك الله في جهودكم جميعا ولتغيير تنسيق الارتباط التشعبي لهذا الملف اتبع الآتي: اضغط على أنماط الخلية cell styles الموجودة ضمن تبويب الصفحة الرئيسية home ضمن مجموعة الأنماط styles كلك يمين على ارتباط تشعبي hyperlink ثم اختيار تعديل modify ستظهر نافذة اضغط على زر تنسيق format تظهر لك نافذة تنسيق الخلية المعروفة ثم تبويب خط font اختر التنسيقات التي ترغب بها ثم اضغط موافق ok ولا تنسوني من صالح دعائكم

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

وعليكم السلام ورحمة الله وبركاته حالياً لا يتم عرض شىء ولا تبقى اخر صورة استبدل الكود التالي Private Sub Form_Current() On Error GoTo HandleErr On Error Resume Next Dim rs As Object If Not IsNull([PicFile]) Then [imgPicture].Picture = [PicFile] SysCmd acSysCmdSetStatus, "Image: '" & [PicFile] & "'." Else [imgPicture].Picture = "" SysCmd acSysCmdClearStatus End If Exit Sub HandleErr: If Err = 2220 Then [imgPicture].Picture = "" SysCmd acSysCmdSetStatus, "Can't open image: '" & [PicFile] & "'" Else MsgBox Err.Description, vbExclamation End If End Sub بالكود التالي Private Sub Form_Current() On Error GoTo HandleErr On Error Resume Next Dim rs As Object If Not IsNull([PicFile]) Then [imgPicture].Picture = [PicFile] SysCmd acSysCmdSetStatus, "Image: '" & [PicFile] & "'." Else [imgPicture].Picture = "C:\Users\mohamed\OneDrive\Desktop\matrix.jpg" SysCmd acSysCmdClearStatus End If Exit Sub HandleErr: If Err = 2220 Then [imgPicture].Picture = "C:\Users\mohamed\OneDrive\Desktop\matrix.jpg" SysCmd acSysCmdSetStatus, "Can't open image: '" & [PicFile] & "'" Else MsgBox Err.Description, vbExclamation End If End Sub مع تغيير مسار الصورة C:\Users\mohamed\OneDrive\Desktop\matrix.jpg تحياتي

تفضل 3.xlsm

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

السلام عليكم وددت أن أشارك هذا الموضوع بملف يقوم بالعمل نفسه لكن بالمعادلات (غير أن النتائج المنتظرة محدودة في النطاق A6:DZ1005 أي من 130 عمود و 1000 سطر)... أضفت بعض التنسيقات على الصف 4 (تنسيقات على الخلايا) و الصف 5 (تنسيق شرطي للتلوين)... بن علية حاجي Num_Table_Formulas.xlsx

السلام عليكم

أخي العزيز / kemas بداية أشكر إخواني الأعزاء هشام شلبي وأبو البراء لما تفضلوا به من أفكار مميزة للحل ولإثراء الموضوع هذا حل إضافي بالمرفق بالورقة الأولى وبالعمود A بالنطاق (A1:A1000) أي رقم تضعه يتم ضربه × 3 ووضع الناتج بالعمود B ، وبالورقة الثانية تم تنفيذ طلبك الثاني وهو جمع العمودين A+B والناتج بالعمود C وهذا أيضاً على مستوى الصفوف من 1 إلى 1000 أرجو أن يناسب هذا طلبك . تحياتي أبو عبدالله ضرب العمود في 3 ومجموع عمودين.rar