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

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

انا لا افهم ما لزوم الحلقات التكرارية في الكود وهي التي تجعل الملف ثقيلاُ (2000 حلقة) يكفي هذا الماكرو Sub SALIM() Application.ScreenUpdating = False Dim ws As Worksheet Set ws = Worksheets("min") Dim Ro_D%, Ro_A% Ro_D = Cells(Rows.Count, "D").End(3).Row Ro_A = Cells(Rows.Count, "A").End(3).Row With ws .Range("g:f").ClearContents .Cells(2, "f").Resize(Ro_D - 1).Formula = _ "=INDEX($J$2:$J$2000,MATCH(D2,$I$2:$I$2000,0))" .Cells(2, "G").Resize(Ro_A - 1).Formula = _ "=INDEX($Q$1:$Q$6,MATCH(A2,$P$1:$P$6,0))" .Range("g:f").Value = .Range("g:f").Value End With Application.ScreenUpdating = True End Sub

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

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

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

بعد إذن أستاذنا الفاضل بن علية الحاجي تم وضع الكود التالي في حدث Woorbook حتى لا يتم الحفظ عند الخروج ولا تظهر رسالة عند الخروج من الملف Private Sub Workbook_BeforeClose(Cancel As Boolean) With Application If Workbooks.Count = 1 Then .DisplayAlerts = False .Quit Else .EnableEvents = False Me.Close SaveChanges:=False End If End With End Sub __مصغر1 - نسخة - نسخة.xlsm

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

أستخدم هذا الكود On Error GoTo Err_Form_Open ChangeProperty "AllowBypassKey", 1, 0 fAccessWindow acHide, False, False With New Access.Application Dim strDbName As String strDbName = CurrentProject.Path & "\Start.accdb" .UserControl = True .RunCommand acCmdAppMaximize DoCmd.RunCommand acCmdAppMaximize .OpenCurrentDatabase strDbName, , "K@serwww$0ficena%9o6" End With Application.Quit Exit_Form_Open: Exit Sub Err_Form_Open: MsgBox "خطأً " & " " & vbCr & vbCr & " تم حذف البرنامج أو تم أعادة تسميته ", 0 + 16 + 1572864, "بدأ التشغيل" Application.Quit Resume Exit_Form_Open ::بالتوفيق:: إذا كنت ترى أن هذه المشاركة مفيدة فلا تنسى التقييم

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

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

جرب هذا الماكرو Option Explicit Sub get_moulahaza() Dim Dic_Name As Object Dim Dic As Object Dim i%, Ro%, ky Ro = Cells(Rows.Count, 2).End(3).Row Range("j4").CurrentRegion.Offset(2, 1).ClearContents Set Dic_Name = CreateObject("Scripting.Dictionary") Set Dic = CreateObject("Scripting.Dictionary") '============================= For i = 2 To Ro Dic_Name(Cells(i, 2).Value) = vbNullString Next '============================= For Each ky In Dic_Name.Keys For i = 2 To Ro If Cells(i, 4) <> "حاضر" And Cells(i, 2) = ky Then If Not Dic.Exists(Cells(i, 2).Value) Then Dic.Add Cells(i, 2).Value, _ Cells(i, 4) & " " & Cells(i, 3) Else Dic(Cells(i, 2).Value) = _ Dic(Cells(i, 2).Value) & " * " & _ Cells(i, 4).Value & " " & Cells(i, 3) End If End If Next i Next ky With Dic Cells(4, "K").Resize(.Count) = _ Application.Transpose(.Keys) Cells(4, "L").Resize(.Count) = _ Application.Transpose(.Items) End With Set Dic_Name = Nothing: Set Dic = Nothing End Sub الملف مرفق مع الكود Exampl_moulahaza.xlsm

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

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

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

تفضل new.mdb

السلام عليكم الظاهر سهوت عن موضوعك جرب هذا التعديل واتمنى من الاخوة من لدية اسكنار يجرب الكود احتمال الاشكالية تكون في نسخة الويندوز لديك Cy_Scan_Ali_2.xlsm

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

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

مساء الخير تمت المعالجة حركات معدل1.xlsm

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

السلام عليكم 🙂 اي وقت اشوف رسالة OLE Server ، الحل هو لغة unicode الكمبيوتر جعفر

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

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

اخي الكريم @omarahmed1424 ساتواصل معك على الخاص حالما اجهز بعض الملفات لتجربة بعد الدوال لتشخيص مكان الخلل

تفضل بعد اذن الأستاذ حسين 1مصغر.xlsm

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

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

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

السلام عليكم 🙂 شكرا اخي كاسر ، فلقد تذكرت اني مررت بمثل هذه المشكلة ، ودخت الى ان عرفت المشكلة 🙂 لما تستخدم الاكسس 2007 فما فوق ، فالاكسس يحمي الكمبيوتر ولا يسمح لك ان تفتح اي برنامج ، اذا اردت فتح البرنامج في مجلد "غير موثوق به" ، لذا ، اذا فتحت البرنامج في مجلد غير موثوق به ، سيظهر لك هذا الخط الاصفر ، وبه زر "تمكين المحتوى" : . لذا عليك بضغط الزر ، وسيعمل الكود في برنامجك بطريقة عادية. ولكن ، وحتى لا تحصل على هذه الرسائل دائما ، يجب عليك ان تعمل مجلد/مجلدات موثوق بها : ويجب ان تتأكد من انك سمحت للاكسس ان يعطيك الخط الاصفر : بعد هذا ، المفروض ان برنامجك يشتغل عدل 🙂 ولكن ، هناك مشكلة يقوم بها الكثير من المبرمجين ، وهذه المشكلة في جعل النموذج: منبثق = نعم ، شكلي او مشروط = نعم ، ويجعل النموذج ينفتح على حجم الشاشة (docmd.maximize) : . فلما ينفتح البرنامج ، سيكون الخط الاصفر خلف النموذج ، فلن تراه ، وعليه لن يعمل البرنامج !! جعفر

نعم وهو الملف الوسيط سيتكفل بهذه المهمة تم التعديل المطلوب ولتسهيل الأمر على مسؤول القاعدة اذا اراد مثلا اظهار الكائنات للتعديل أو الإطلاع تمت اضافة زر أمر لاظهار الكا ئنات وشريط الادوات بدل ما يقوم بألغاء كلمة السر ثم اعادة تفعيل الشفت وفتح القاعدة من جديد فقط نقرة زر كل شي يكون أمامه طبعا زر الأمر لازم يكون مخفي عن المستخدم ونقوم بإيجاد طريقة لاظهاره للمسؤول بالنسبةلي بما اني استخدم نظام صلاحيات مستخدمين أضع هذا الكود عند فتح النموذج لاظهار زر الأمر وتفعيله If MyUser.username() = "Kaser906" Then Me![cmd47].Enabled = True Me![cmd47].Visible = True End If الملف بالمرفقات ::بالتوفيق:: إذا كنت ترى هذه المشاركة مفيدة فلا تنسى التقييم FreeKaser906.rar

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

تحياتي الخالصة تم عمل المطلوب بالتعديل على معادلات "الترتيب - 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