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

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

تفضل اخي الكريم قاعدة بيانات التلاميذ(2).rar يفضل اخذ نسخة احتياطية من برنامج اولا قبل التجربة تحياتي

وعليكم السلام ورحمة الله وزبركاته استاذنا الفاضل @أبو عبدالله الحلوانى الكود التالي صحيح msgbox me.width وهو يعطي النتيجة بالبوصة والبوصة = 2.541cm ولمعرفة العرض بالضبط اقسم الرقم الناتج على 2.541cm وايضاً 2.541cm = 1440 twips ولتحديد العرض من خلال الكود نضرب 1440 twips في الرقم المراد تحديد العرض به بالبوصة Me.Width = 1440 * 6 تحياتي

يسر الله امرك كما يسرتم امرى واكثر الله من امثالك وحقق فيما يرضيه امالك وشكرا على هذا الجهد الطيب

ضع الكود التالي في وجدة نمطية جديدة Option Compare Database Public Declare PtrSafe Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long Public Sub HideAccess() Call ShowWindow(Access.hWndAccessApp, 0) End Sub Public Sub ShowAccess() Call ShowWindow(Access.hWndAccessApp, 5) End Sub للاخفاء ضع هذ الكود في حدث عند التحميل للنموذد الرئيسي Call HideAccess للاظهار ضع هذا الكود في زر امر Call ShowAccess تحياتي مع مراعاة ان تجعل النماذج والتقارير منبثقة

تم التعديل على الماكرو ليتناسب مع المطلوب Option Explicit Sub get_data_new() Dim S As Worksheet, T As Worksheet Dim Rg_T As Range, Cel_T As Range Dim Rg_S As Range, Cel_S As Range Dim Dc As Object, K Dim x%, lr%, m%: m = 5 Set S = Sheets("Source") Set T = Sheets("Target") Set Rg_T = T.Range("W5", Range("W4").End(4)) Set Rg_S = S.Range("C9", S.Range("C8").End(4)) Set Dc = CreateObject("Scripting.Dictionary") With T.Range("AA4").CurrentRegion.Offset(1) .Interior.ColorIndex = xlNo .ClearContents End With T.Range("AA5").Resize(, 3).Interior.ColorIndex = 40 For Each Cel_T In Rg_T K = Cel_T & " " & Trim(Cel_T.Offset(, 1)) For Each Cel_S In Rg_S If Cel_S & " " & _ Trim(Cel_S.Offset(, 1)) = K Then _ Dc(Cel_S.Offset(, -1).Value) = "" Next Cel_S With T.Cells(m, "AA") .Resize(Dc.Count) = _ Application.Transpose(Dc.keys) lr = .Parent.Cells(Rows.Count, "AA").End(3).Row .Parent.Cells(lr + 1, "AA").Resize(, 3) _ .Interior.ColorIndex = 40 .Offset(, 1).Resize(, 2) = _ Split(K, " ", 2) End With m = m + Dc.Count: Dc.RemoveAll Next Cel_T T.Range("AA" & lr + 1).Resize(, 3). _ Interior.ColorIndex = xlNo Set Dc = Nothing End Sub Fousoul_stds_with color.xlsm

وعليكم السلام إذا كان الزبون يستخدم نسخة 2019 أو 365 يحتاج تحديث فقط هنا نفس المشكلة جرب ووافيني بالنتائج . واجهتني نفس المشكلة

السلام عليكم جرب المرفق لعل فيه ما تريد... المعادلة المستعملة في الملف هي معادلة صفيف ويجب تأكيدها بواسطة CTRL+SHIFT+ENTER. بن علية حاجي New Microsoft Excel Worksheet (3) (1).xlsx

السلام عليكم ورحمة الله وبركاته ،، استكمالا لموضوع الاستاذ حسين فى هذه المشاركة الخاص بتغيير الالوان فى الاكسس .. جزاه الله كل خير فرأيت ان افرد مشاركة لهذا الموضوع ارجو ان تتقبلوه منى هدية لكم اولا : مرفق ملف PDF به كل الالوان ورقمها يمكنك فقط وضع الرقم فى خصائص الحقل او الخلفية او عن طريق الكود وسيعطى لك اللون المطلوب Access Color Code.pdf ثانياً: لو اخترنا مثلا اللون الفسفورى مثل ما ذكر حبيبنا استاذ حسين بارك الله فيه فنجد ان اللون الفسفورى يكتب فى الكود بالرقم التالي txt_RGB.BackColor = RGB(191, 255, 0) وفى خصائص النموذج تجده هكذا #BFFF00 ومرفق مثال تطبيقى بسيط وقد تم وضع رقم اللون الفسفورى فى خصائص الخلفية وايضا تم وضع حقل لتغيير الخلفية له عن طريق الكود M.S - RGB 24-11-2019.rar

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

السلام عليكم حبيت اعمل مشاركة بسيطة وياكم بعض اكواد VBA لكل من يبي يعمل واجهة نظامية تحياتي ADO.rar

شكرا استاذي هذا ما كنت اريده فجزاك الله كل خير

هذا الماكرو يقوم بما تريد Option Explicit Sub TAKDIRAT() Dim Rg As Range, cel As Range Dim Note$ Set Rg = Range("A9", Range("A8").End(4)).Offset(, 9) Rg.ClearContents For Each cel In Rg If IsNumeric(cel.Offset(, -1)) Then Select Case cel.Offset(, -1) Case Is < 7: Note = "نتائج غير مقبولة" Case Is < 10: Note = "نتائج دون الوسط" Case Is < 12: Note = "نتائج متوسطة" Case Is < 14: Note = "نتائج حسنة" Case Is < 16: Note = "نتائج جيدة" Case Is < 18: Note = "نتائج جدة جداً" Case Else: Note = "نتائج ممتازة" End Select cel = Note End If Next End Sub الملف مع الكود Formules.xlsm

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

استاذنا الفاضل @أبو عبدالله الحلوانى اقصد انك قمت بتغيير خحم ورق الطباعة الى a5 لكن التقرير ما زال محتفظ باعداداته والعناصر التي عليه بنفس المقاسات لم تتغير الحقيقة جربت الموضوع قبل ذلك فالذي وصلت اليه كتابة اسماء العناصر يدوياً Me.TextBox1.Width = Me.TextBox1.Width / 2 فارجو ان يحاول معنا الاخوة في هذا الموضوع الشيق لعلنا نصل الى نتيجة ان شاء الله تحياتي

اخي العزيز لاتظهر عندي اي رسالة فقط غيرت لك كود فتح التقرير ‏‏‫‏‏Library211.rar

صديقي لا حاجة للكود في مثل هذا الحالة Formules.xls

لا ضرورة لهذه الاعمدة المساعدة من اجل القوائم المنسدلة تم معالجة الامر في الملف المرفق Tansik.xlsm

جرب البحث الآن Example_2 (1).accdb

تفضل اعتقد ان هذا الملف يفيدك اكثر دوام الموظفين الاضافي و التأخير و المغادرة إكسل.xlsx

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

هذا بالمعادلات ولا أدري ان كان نفس المطلوب أم لا ؟ {=IFERROR(INDEX($A$2:$A$50;MATCH(0;COUNTIFS($A$2:$A$50;"<"&$A$2:$A$50)-SUM(COUNTIF($B$1:B1;$A$2:$A$50));0));"")} Book1 (1).xlsx

السلام عليكم 🙂 اخي محمد ، شو اللي تريد ان توصل له ؟ هذه حروف unicode مال مناطق Latin-1 ، فطبيعي ما تظهر في نافذة VBE. جعفر

السلام عليكم اخي الكريم ما رأيك بهذه الطريقة البحث بواسطة الاسم او رقم الهاتف بواسطة مربع نص . شوف الملف بالتوفيق Example_2.accdb

السلام عليكم تقضل اخي اضطررت لتصدير القاعده الى ملف جديد وعملت التعديلات لان ملفك كان فيه مشاكل ارجو ان يكون هو المطلوب. مثال.rar

ادعوني باسم sandanet او ساندانت

دائماً أقوم بتحويل من أقل إصدار مثل 2010 حتى يستطيع من لديه إصدار أعلى بفتحه لا مانع

هل النسخة لدى الزبون بصيغة accde

ما شاء الله عليك استاذنا الفاضل وجزاك الله خيراً تحياتي

الاخ thewound22 شاهد المرفقات Test_1.rar

اكنب هذا file_name = Application.GetSaveAsFilename(InitialFileName:=strFileName, FileFilter:="Excel Macro-Enabled Workbook (*.xlsm), *.xlsm") wb.SaveAs Filename:=file_name, FileFormat:=52

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

وعليكم السلام-وذلك من خلال الدخول الى فيديوهات اليوتيوب ومشاهدة ما تطلب

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

السلام عليكم هذا توزيع آخر مع التوزيع السابق... بن علية حاجي توزيع2.xlsx

موضوع جميل وفيد جدا جزاك الله كل خير ي استاذ محمد

مطلوب شيت كنترول المرحلة الاعدادية

وعليكم السلام ورحمة الله وبركاته لمعرفة حجم قاعدة البيانات نستخدم الامر FileLen(CurrentDb.Name) مع ملاحظة ان الرقم يخرج بالبايت بعني انك ستحتاج الى قسمته على 1024 ليعطيك الحج بالكيلوبايت ثم القسمة على 1024 ليعطيك الحجم بالميجا استخدم الكود التالي وهو عند حجم 30000000 بايت يما يعادل 30 ميجا تقريباً If FileLen(CurrentDb.Name) > 30000000 Then Application.SetOption "Auto compact", True Else Application.SetOption "Auto compact", False End If الكود يقوم بوضع علامة صح امام خيار ضغط واصلاح قاعدة البيانات عند الاعلاق تحياتي

متميز اخي @خالد سيسكو

ربما هذا الكود يفي بالغرض Sub test() Dim lr Dim x lr = Range("a" & Rows.Count).End(xlUp).Row Range("i3:i" & lr).Formula = "=SUMIF($B:$B,$A:$A,H:H)" Range("i3:i" & lr).Value = Range("i3:i" & lr).Value Range("k3:k" & lr).Formula = "=SUMIF($B:$B,$A:$A,J:J)" Range("k3:k" & lr).Value = Range("k3:k" & lr).Value Range("m3:m" & lr).Formula = "=SUMIF($B:$B,$A:$A,L:L)" Range("m3:m" & lr).Value = Range("m3:m" & lr).Value End Sub

السلام عليكم عملت لك نموذج بسيط لقتح وحفظ مسار pdf ضمن الاكسس اعلمنا النتائج image+pdf.rar

غير خصائص مربع القائمة كما في الصورة .....

السلام عليكم ورحمه الله السادة الأعضاء المحترمين لقد قمت بشرح طريقة بحث وتصفية وفرز وفلترة السجلات بطريقة جديدة بدون اكواد طريقة بسيطة حتي يقدر يستفيد منه أي عضو الموقع غني بمواضيع مشبها ولكن لكل شيخ طريقة اترككم مع الفيديو رابط تحميل الملف https://drive.google.com/file/d/19PeZ77AKZ7Ki56ZiOpJaGcsqIjKv3wEZ/view?usp=drivesdk

أخى الحسن هل فى المرفق ما تريده تم إضافة "الكل" لـ cboAddName جرب وأفدنى إن لم يكن هو المطلوب والله الموفق AddressSearch.rar

تفضل Visitors.mdb

بارك الله فيك وجزاك الله كل خير

تحديث للمرفق: تم إضافة إمكانية التعديل على الأكواد Items Coding System V2.rar

مشكووووووور اخي الكريم