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

السلام عليكم ورحمة الله وبركاته.. في الوضع الطبيعي الاكسس يعطينا فقط مجموعة الوان عند تنسيقها في الكود Constant Value Description vbBlack 0x0 Black vbRed 0xFF Red vbGreen 0xFF00 Green vbYellow 0xFFFF Yellow vbBlue 0xFF0000 Blue vbMagenta 0xFF00FF Magenta vbCyan 0xFFFF00 Cyan vbWhite 0xFFFFFF White ولكن كثيراً ما نريد ان نقوم بإختيار الواناً غير التي موجودة في الاعلى مثلا اللون الفسفسوري غير موجود في القائمة. قمنا باخذ قيمة اللون الفسفوري من احد برامج تعديل الصور وليكن مثلا الفوتوشوب لكن احيانا تواجهنا مشاكل ورسائل مزعجة من الاكسس عند وضع الالوان عن طريق VBA مثلا انا دائما ماكانت تصادفني رسالة مزعجة Expected Array عندما اقوم بوضع اللون بالصورة الاتية: txt_name.BackColor = RGB(20,30,60) تظهرلي هذه الرسالة: فكرت في تحويل اللون من HEX الى OLE ، وقد تم تغيير اللون بنجاح وبدون اي رسائل خطأ Public Function HEX2OLE(ByVal hexValue As String) As Long Dim R, G, B As Long If Left(hexValue, 1) = "#" Then hexValue = Replace(hexValue, "#", "") R = CByte("&H" & Left(hexValue, 2)) G = CByte("&H" & Mid(hexValue, 3, 2)) B = CByte("&H" & Mid(hexValue, 5, 2)) HEX2OLE = CLng(R + (G * 256) + (B * 65536)) End Function بالتوفيق للجميع. HEX_2_OLE.accdb

السلام عليكم ورحمة الله وبركاته تانية طريقة هنشرحها باذن الله هى طريقة .. شرح تصدير البيانات من الاكسس الى ملف ورد معد مسبقا عن طريق الاشارة المرجعية الفيديو https://youtu.be/VtPEat0Qkqo MS_Export data to Word file.rar

السلام عليكم ورحمة الله وبركاته اهلا بحضرتكم جميعا النهاردة باذن الله هشرح طريقة جديدة .. للتأكد من ملء كافة الحقول قبل الانتقال الى سجل جديد مع الغاء زر الانتر والتاب من الانتقال بهم الى سجل جديد وده شرح فيديو لطريقة تنفيذ الطريقة MS_Be sure to fill in all fields.rar

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

اعتذر لك لم اعمل حفظ للمرفق حيث قمت بالتعديل وهو بالوينرار ولم احفظه مرفق الملف بعد التحديث طبتم واهتديتم AZIZ_up1.rar

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

جرب المرفق Database11.mdb

وعليكم السلام مرفق بعد اجراء بعد التعديلات - تحياتى test3.accdb

استاذي العزيز @محمد سلامة تم تفعيل نسختك

استاذ احمد بدره تستاهل الف الف الف اعجاب لا تؤاخذوني على التاخير في شكركم استاذ احمد بدره يا رائع

اخي @qathi تفضل DatabaseRestartV1.2.accdb DatabaseRestartV1.2.mdb المصدر : http://blog.nkadesign.com/2008/05/06/ms-access-restarting-the-database-programmatically/

شكرا لكما معلمينا الأفاضل على الإفادة جزيتم خيرا

وعليكم السلام 🙂 في الواقع هذه ميزات الاكسس ، عندك اكثر من طريقة لعمل اي شيء 🙂 شكرا لك 🙂 جعفر

السلام عليكم يمكنك الاستعانة بالرابط التالي : https://www.dummies.com/software/microsoft-office/excel/how-to-use-the-xlookup-function-in-excel-2016/ بن علية حاجي

السلام عليكم و رحمة الله وبركاته استفدت كثيرا من مشاركات الاخوة الاعزاء قبلي و لكن احيانا اعجز عن تعديل الكود ليناسب عملي , ارجو منكم المساعدة ,,, في الملف المرفق , المستخدم للبرنامج يشكو من الاخطاء التي تحدث عند كتابة اسماء الصور الي معالج الماسح الضوئي , و كذلك المسار لمجلد الحفظ ( حيث ان طلبة يتم حفظ الوثائق علي شكل صور JPEG في مجلد عادي ) ,, فهل نستطيع ان نجعل الكود يقوم تلقائيا بنسخ اسم الصور من النموذج العلوي الي نموذج معالح الماسح الضوئي ,,, وجدت في المنتدي مشاركة للاستاذ احمد زمان , و لكني عجزت عن تعديل الكود ليناسب المستخدم و يلبي طلبة , كما انني وجدت كود للاستاذ المبدع ابو هادي في قسم الاكسيس لكنة لم يعمل في الاكسيل ارجو المساعدة ولكم جزيل الشكر majeed.xls

أ.emam1424 مش عارف انا فهمت صح ولا لأ .. جرب وولفنى بالنتيجة Saifi.zip

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

السلام عليكم تم إضافة الكود التالي في كود حدث كل الشيتات (من بينها ThisWorkBook)... Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Save End Sub ولحذف رسالة "تحذير حول الخصوصية" نتبع خطوات الفيديو (ملف تنفيذي مضغوط) في الملف المرفق (وقد تم ذلك في نسخة أوفيس 2016 بالفرنسية)... بن علية حاجي test.rar

اختي الكريمة @علياء يسرالدين الملف المرفق التالي فيه تعديل بسيط على ماتقدم به الأخ REDA test3.accdb

جميل جدا بارك الله فيك نتمنى منك المزيد من هذه الابداعات

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

السلام عليكم استاذي القدير الـعيدروس كل التقدير والمحبة لك وجزاك الله عنا خيرا اولا: قاعدة بيانات الرحلات ( تعريف الرحلات ) كما هو في الشكل التالي ثانيا : تسجيل بيانات المعتمرين من خلال الفورم حسب كل رحلة حيث لكل رحلة معتمريها في كشف خاص ويتوجب استخراج تقرير لها كما هو في الشكل التالي ثالثا : نبدأ بتسكين المعتمرين حسب ما يطلبوه من غرف رباعية ثلاثية ثنائية كما هو واضح بالمرفق ويتوجب استخراج كشف التسكين للرحلة رابعا : اعداد الفواتير المشتريات والمبيعات كما انت اعددتها بالفورم مع تحياتي لكم المصنف1.xlsx

الاستاذ الفاضل / @محمد سلامة جميل جدا هذا الموضوع بارك الله فيك وجعله في ميزان حسناتك نرجو المزيد مثل هذه المواضيع

وعليكم السلام-تفضل طريقة تصميم فورم بحث عن طريق لست بوكس5.xlsm

تفضل new.mdb

السلام عليكم راجع الملف المرفق لعل فيه ما تريد... بن علية حاجي _مصغر1 - نسخة.xlsm

تفضل اخي الكريم UP-Test(2).accdb تحياتي

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

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

استاذ محمود رواس كل ده تمام ولكن اين الضغط على الإعجاب ؟ على الرغم ان هذا هو أقل ما يقدم لهم على كل ما قدموه لك

ابو عبدالله شكرا عبد اللطيف شكرا الله يعطيكم العافيه

العفو اخى الكريم والشكر لله اولا واخير تقبل تحياتى وتمنياتى لك بالتوفيق طبتم واهتديتم

Sub test() Dim a As Variant, lr, i, x, s, k, itm Dim bch As Worksheet Set bch = Sheets("Bank Cheque") lr = bch.Cells(Rows.Count, "a").End(xlUp).Row - 1 a = Application.Index(bch.Cells(2, 2).Resize(lr, 21).Value, Application.Evaluate("row(1:" & lr & ")"), Array(1, 2, 6, 7, 8, 13, 16, 20)) With CreateObject("scripting.dictionary") For i = 1 To UBound(a) If bch.Cells(i + 1, 4) = Sheets("Sheet4").Range("d3") And bch.Cells(i, 4) <> "" Then If Not .exists(Cells(i + 1, 4)) Then .Add bch.Cells(i + 1, 4), a(i, 1) & Chr(162) & a(i, 2) & Chr(162) & a(i, 3) & Chr(162) & a(i, 4) & Chr(162) & a(i, 5) & Chr(162) & a(i, 6) & Chr(162) & a(i, 7) & Chr(162) & a(i, 8) Else .Item(bch.Cells(i + 1, 4)) = .Item(Cells(i + 1, 4)) & Chr(162) & a(i, 1) & Chr(162) & a(i, 2) & Chr(162) & a(i, 3) & Chr(162) & a(i, 4) & Chr(162) & a(i, 5) & Chr(162) & a(i, 6) & Chr(162) & a(i, 7) & Chr(162) & a(i, 8) End If End If Next k = .keys itm = .items Ct = .Count With Sheets("Sheet4") Range("a8:f10000").ClearContents For i = 1 To Ct x = Split(itm(i - 1), Chr(162)) .Range("a" & 8 + i - 1).Resize(, UBound(x) + 1) = x Next End With End With End Sub اسم الشركة فيD3

وبعد اذن جميع الأساتذة وزيادة فى اثراء الموضوع-تفضل Bank Cheque.xlsm

بعد اذن الاستاذMohamed_Fouad واثراء للموضوع جرب المرفق Bank Cheque.xlsm

و عليكم السلام و رحمة الله تفضل اخى الكريم اتمنى ان يكون هذا هو طلبك Bank Cheque.xlsx

اخي @سيروان زيباري هل تم حل المشكلة ؟

السلام عليكم 🙂 هذا ناتج عن خطأ من مايكروسوفت في احد تحديثاتها الاخيرة ، والحل هنا : جعفر

ترحيل خليه محدده بدون التنسيق.xlsm

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

جرب المرفق ::بالتوفيق:: إذا كنت ترى أن هذه المشاركة مفيدة فلا تنسى التقييم Database2.rar

جرب هذا الملف TEST_new-2.xlsm

ربما يكون المطلوب TEST_new.xlsm

بعد اذن الاساتذة الكرام هذه المعادلة في الخلية F3 معادلة صفيف (CTRL+SHIFT+ENTER) =MID(E3,1,MIN(IFERROR(FIND(ROW($A$1:$A$100)&" ",E3)+1,""))) هذه المعادلة في الخلية G3 معادلة صفيف (CTRL+SHIFT+ENTER) =MID(E3,MIN(IFERROR(FIND(ROW($A$1:$A$50)&" ",E3)+1,""))+1,LEN(E3)) الملف مرفق صفحة salim salim2.xlsx

السلام عليكم بعد اذن استاذنا الكبير بن علية حاجى يمكنك محاولة تفهم المعادلات بنفسك لحسن التعلم فهذه المعادلة تستخدم لفصل المادة : =IF(E3="","",IF(ISERROR(FIND("/",E3,1)),TRIM(MID(E3,1,FIND("الشعبة",E3,1)-1)),TRIM((MID(E3,1,FIND("الشعبة",E3,1)-1))&(MID(E3,FIND("/",E3,1),FIND("الشعبة",E3,1)-1))))) وهذه لفصل الشعبة -فكل ما عليك تغيير رقم الخلية التى بداخل المعادلة للخلية التى تريد الفصل منها =IF(E3="","",IF(ISERROR(FIND("/",E3,1)),TRIM(MID(E3,FIND("الشعبة",E3,1)-1,15)),TRIM(MID(E3,FIND("الشعبة",E3,1)-1,FIND("/",E3,1)-FIND("الشعبة",E3,1)+3))&" "&TRIM(MID(E3,FIND("الشعبة",E3,FIND("/",E3,1)),15)))) اتمنى ان تكون قد تفهمت الموضوع فهو بسيط وسهل

السلام عليكم تم التصرف في الجدول وإضافة المعادلات اللازمة للمطلوب (ربما تكون طويلة بعض الشيء)... بن علية حاجي 22222222222.xlsx

السلام عليكم اليك المثال فالنموذج اختر فرع 1 من الكمبوبوكس سيفتح التقرير قد ساعدنى به الاستاذ مارد وهو استاذ @Elsayed Bn Gemy ان شاء الله تستفيد منه تمنياتى لكل بالتوفيق تقرير اجماليات.rar

تحياتي الخالصة تم عمل المطلوب بالتعديل على معادلات "الترتيب - 2" (وهي معادلات صفيف لكن لا تحتاج إلى تأكيدها بواسطة ctrl+shift+enter). أرجو أن يفي الغرض المطلوب... بن علية حاجي ترتيب اوائل الفصول.rar

من روائع القدر أن يضع الله في دربك من يُنيرون لك الطريق، فهؤلاء وحدهم من يستحقون الشكر والامتنان نعم هو كده تمام شكرا استاذ سليم شكرا استاذ حسين

حرب هذا الماكرو Sub RAND_NUM() Dim i%, k%, M%, Y Dim OBJ As Object Range("A5", Range("A4").End(4)).ClearContents Set OBJ = CreateObject("System.Collections.Sortedlist") For i = 1 To [c2] Randomize Y = Rnd() OBJ.Add Y, i Next M = 5 For k = 0 To OBJ.Count - 1 Cells(M, 1) = OBJ.IndexOfValue(k + 1) + 1 M = M + 1 Next End Sub الملف مرفق Rand_numbers.xlsm