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

جرب هذا الكود Option Explicit Private Sub Worksheet_Activate() fil_dat_val End Sub '+++++++++++++++++++++++++++++++++++ Sub fil_dat_val() Application.ScreenUpdating = False Dim I%: I = 6 Dim arr Dim rg As Object Set rg = CreateObject("system.collections.arraylist") With rg Do Until Sheets("sheet1").Range("B" & I) = vbNullString If Not .contains(Sheets("sheet1").Range("A" & I).Value) Then _ .Add Sheets("sheet1").Range("A" & I).Value I = I + 1 Loop .Sort arr = .toarray arr = Join(arr, ",") End With With Sheets("sheet2").Range("H2").Validation .Delete .Add xlValidateList, Formula1:=arr End With End Sub '============================== Sub get_values() Dim rg As Object, I%, m%, kY Dim Sh1 As Worksheet, Sh2 As Worksheet I = 6 Set Sh1 = Sheets("Sheet1"): Set Sh2 = Sheets("Sheet2") Set rg = CreateObject("Scripting.dictionary") Sh2.Range("a6").CurrentRegion.Offset(1).Clear With Sh1 Do Until Not IsNumeric(.Range("a" & I)) If .Range("A" & I) = Sh2.Range("h2") _ And .Range("C" & I) >= Sh2.Range("I2") _ And .Range("C" & I) <= Sh2.Range("J2") Then rg(m) = _ .Range("C" & I).Value & "*" & _ .Range("D" & I).Value & "*" & _ .Range("E" & I).Value m = m + 1 End If I = I + 1 Loop End With If rg.Count = 0 Then GoTo End_Me m = 6 For Each kY In rg.keys Sh2.Cells(m, 1).Resize(, 3) = _ Split(rg(kY), "*"): m = m + 1 Next With Sh2.Range("A6:C" & m - 1) .Value = .Value .InsertIndent 1 .Borders.LineStyle = 1 .Font.Size = 14 End With End_Me: Application.ScreenUpdating = True Set rg = Nothing End Sub Saerch_by_date.xlsm

تفضل يمكنك ذلك بإستخدام هذه المعادلة بالتنسيق الشرطى =AND(COUNTIF($A$2:$A$310,H2)=0,H2<>"") تنسيق شرطى للمختلف.xlsx

السلام عليكم الأفضل تجميع البيانات في ملف واحد ، بل في ورقة واحدة لكن علي كل حال تستطيع إستخدام الدالة ( في لوك اب) مع خاصية المطابقة التامة أي مثل VLOOKUP(X,Range,n,0) أي تجعل الدالة تبحث عن المتغير بالضبط تطابق وإلا ترجع بخطأ وذلك عن طريق المتغير الرابع بالدالة تعطيه قيمة 0 أو False ثم قبل الدالة ، تضيف دالة أخري Iferror والتي تغير نطاق البحث من الملف A إلي B مثلا لو أعطي البحث الأول خطأ تفضل الملف به الدالتين ABC.xlsx

TRY THIS FILE ROW_NYMMBER.xlsx

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

السلام عليكم تغضل اخي الكريم ملفك بعد التعديل اتمنى يكون المطلوب Database4.rar

بعد اذن استاد طارق محمود ولاثراء الموضوع جرب المرفق 1 انسخ المجلد المسمى mydata في :d 2 افتح الملف المسمى main واضغط زر استعلام سيأتي ببيانات حسب الرقم في العمود A ملاحظة تم تغيير اسماء الشيتات ليعمل الكود بكفاءة ارجو ان يكون ما تريد my data.rar

داخل المرفقات شوفها بعد التحميل Password: 123456

Mahmoud Mostafa Mandour أين الضغط على الإعجاب ؟!!💙

بالتوفيق رجاءٌ موجه إلى المشرف مشكوراً غير مأمور. تغيير العنوان ليكون: أصغر قيمة في حقول ضمن السجل نفسه / سجل واحد أو حسب ما يرتئي حتى يكون العنوان معبراً يمكن للباحث الاستفادة من مضمون السؤال وعدم تكراره. وجزاكم الله كل خير.

تستطيع ذلك، تحتاج برنامج Android Studio لكي تقوم بعمل تطبيق لعرض الرقم المتصل عن طريق BroadcastReceiver وبعدها ترسله لواجهة الكومبيوتر هذا حل سريع: https://www.cnet.com/how-to/you-can-now-place-and-receive-android-phone-calls-on-your-windows-pc/

بعد اذن استاذنا الفاضل واخونا الحبيب استاذ سليم جزاه الله عنا خير الجزاء واثراء للموضوع جلب رقم الصف.xlsx

بعد أذن الأخ Ali Mohamed Ali الأخ Saadrafic شاهد المرفق هو يعمل جيدا مع ويندوز 64 والمفروض انه يعمل مع ويندوز 32 لقد قمت بتجربة الكود علي windows 32 bit وهو يعمل جيدا ايضا اذن الكود المرفق سابقا يعمل علي كل من نسختي ال windows سواء كانت 32 bit أو 64 bit Show_Keyboard.xlsm

تفضل هذه المعادلة Option Explicit Option Compare Text Function kh_count_y_m_d(Mydate_Birth As Date, Optional Mydate_Now _ , Optional Y_M_D As String = "Y_M_D", Optional MyCalendar As Boolean) Dim Mydate As Date, KH_Calendar As Integer Dim D_1 As Integer, D_2 As Integer, M_1 As Integer, M_2 As Integer, Y_1 As Integer _ , Y_2 As Integer, D As Integer, M As Integer, Y As Integer If IsDate(Mydate_Now) Then Mydate = Mydate_Now Else Mydate = Date If IsDate(Mydate_Birth) And CDate(Mydate_Birth) <= CDate(Mydate) Then KH_Calendar = Calendar If MyCalendar = True Then Calendar = 1 Else Calendar = 0 D_1 = Day(Mydate): D_2 = Day(Mydate_Birth) M_1 = Month(Mydate): M_2 = Month(Mydate_Birth) Y_1 = Year(Mydate): Y_2 = Year(Mydate_Birth) If D_1 >= D_2 Then D = D_1 - D_2: M = 0 Else D = D_1 + 30 - D_2: M = -1 If M_1 + M >= M_2 Then M = M_1 + M - M_2: Y = 0 Else M = M_1 + M + 12 - M_2: Y = -1 Y = Y_1 + Y - Y_2 If Y_M_D <> "Y" Or Y_M_D <> "M" Or Y_M_D <> "D" Then kh_count_y_m_d = Y & "y-" & M & "m-" & D & "d" If Y_M_D = "Y" Then kh_count_y_m_d = Y If Y_M_D = "M" Then kh_count_y_m_d = M If Y_M_D = "D" Then kh_count_y_m_d = D Calendar = KH_Calendar End If End Function kh_count.xlsm

المرحلة الاولي: اضغط زر ويندوز + r اكتب appwiz.cpl ثم اضعط Enter اختار Intel Optane Pinning Explorer Extensions. ثم اختار Repair المرحلة الثانية اضغط زر ويندوز + X ثم اختار Device Manager ثم اختار Intel® Pinning Shell Extensions ثم اختار Software components ثم Uninstall Device

السلام عليكم ورحمة الله وبركاته اخوانى الكرام بالمنتدى كل عام وانتم بخير وتقبل الله منا ومنكم صالح الاعمال لاحظت انه يوجد اسئلة حول كيفية انشاء شريط ادوات مخصص لاكسيس 2007 و 2010 حيث انه فى الاصدارات السابقة من اكسيس 2003 و 2000 كان يمكنك بواسطة الاكسيس نفسه ان تقوم بهذا الامر اما فى اكسيس 2007 وما فوق فيوجد عدة طرق لكنها لا تاتى بالغرض دائما الطريقة الاولى : هو الذهاب الى File فى حالة 2010 او زر الاوفيس فى حالة 2007 واختيار Options ثم 1- الذهاب الى Customize Ribbon ونختار New Tab ونلاحظ ظهور شريط او تبويب جديد باسم (New Tab (custom وتحته مجموعة Group جديد باسم (New Group (custom وهذا يكون بشكل افتراضى ولتغيير اسم التبويب نحدده ونضغط Rename ونكتب الاسم ولتسمية Group نحددها ونضغط Rename 2- اضافة الازرار نقوم بعد ذلك باضافة الازرار بواشسظة السحب والالقاء Drag Drop ويمكن ان نختار الازرار التى نريدها من القائمة فى الاعلى والتوضيح فى الصورة هذه الطريقة لاضافة اوامر موجودة بالاكسيس اصلا ك النسخ واللصق والمحاذاة باختصار الاوامر الموجودة بشريط الادوات 3- اذا اردنا ان قوم باضافة زر يقوم بعمل شىء مخصص مثلا يقوم بفتح فورم معين اولا نقوم بانشاء الماكرو الخاص بالعملية ونسميه مثلا OpenForm والآن نذهب الى Customize ونختار Macros ثم نضيف الماكرو الذى نريده واخيرا يمكن اظهار او عدم اظهار اى من التبويبات باغاء علامة check بجانبها وهكذا نكون قد انتهينا من الطريقة الاولى وعيوب هذه الطريقة انها تطبق على جميع قواعد البيانات الموجودة عندك وليس على واحدة فقط اذا نقلت قاعدة البيانات الى جهاز آخر لا تعمل الاشرطة لان هذا التخصيص يكون فى الاكسس نفسه ويمكن حل هذه المشكلة بتصدير التخصيص ثم نقله الى الجهاز المطلوب واستيراده

الاجابة في النطاق الاصفر من هذا الملف Spec_Char.xlsx

الان ممتاز سهل الله امورك اخي العزيز

روعة جزاك الله خيرا الجزاء استاذي Ali Mohamed Ali

Option Explicit Sub test() Dim x1, x2, lr1, lr2 Application.ScreenUpdating = False Range("f5:h100").ClearContents lr1 = Range("b" & Rows.Count).End(xlUp).Row lr2 = Range("e" & Rows.Count).End(xlUp).Row For x1 = 4 To lr1 For x2 = 5 To lr2 If Cells(x1, 2) = Cells(x2, 5) Then If Cells(x1, 3) = "A" Then Cells(x2, 6) = Cells(x2, 6) + 1 ElseIf Cells(x1, 3) = "B" Then Cells(x2, 7) = Cells(x2, 7) + 1 ElseIf Cells(x1, 3) = "C" Then Cells(x2, 8) = Cells(x2, 8) + 1 'ElseIf Cells(x1, 3) = "D" Then 'Cells(x2, 9) = Cells(x2, 9) + 1 ' 'ElseIf Cells(x1, 3) = "E" Then 'Cells(x2, 10) = Cells(x2, 10) + 1 ' 'ElseIf Cells(x1, 3) = "G" Then 'Cells(x2, 11) = Cells(x2, 11) + 1 End If End If Next Next Application.ScreenUpdating = True End Sub جرب المرفق كود حلقات تكرارية 01.xls

لا اعمل مع ملف مسماتة شيتاته باللغة العربية( اكثر من مرة ذكرت ذلك) غير اسماء الصفحات الى اللغة الاجنبية و سأحاول المساعدة

ماشاء الله مهندس طارق جزاكم الله خير

لو أرفق ملف للتعديل افضل .... هل تريد حفظها في نفس مجلد البرنامج أم في مكان إخر ؟؟؟؟؟؟؟ على كل حال أنظر هذا الكود وقم بتعديل ما يلزم حسب مصدر اسم الملف المطلوب هل هو مربع نص أو حقل في جدول أوووووو DoCmd.OutputTo acOutputReport, "Report1", acFormatPDF, CurrentProject.Path & "\" & [text70] & ".pdf", False هذا الكود يحفظ لك الملف في مجلد البرنامج أي بجوار برنلمج مباشرة

تفضل اخي على حسب ما فهمت منك ارجو ان يكون هذا طلبك برنامج لتنظيم الوقت والمواعيـــــــــــد 11.xlsm

لمن يعاني من ترتيب المخزن وجرده ويريد برمجه بسيطه تنظم مخزنه هذا هو الحل برنامج إدارة مخازن بسيط جداً معتمد علي الأكسيل وقد جمع كم هائل من المعادلات المعده مسبقاً حتي يكفي الغرض منه فهو يحتوي علي صفحة الأصناف والكميات وصفحة لحركة المخزن ككل .وفواتير المبيعات وكتابة الفواتير وتصديرها لصفحة فواتير المبيعات شرح مبسط للبرنامج 1. بعد تحميل البرنامج وفك الضغط عنه بستخدام أي برنامج فك ضغط نجد ملف به البرنامج وملف به باسورد البرنامج عند فتح البرنامج أول مره بيطلب تفعيل ميزة الماكرو ** تنبيه: الماكرو تفعيله لا يضر الجهاز طالما الملف من مكان موثوق .واذا لم تفعله لاتقلق فسوف يعمل البرنامج بشكل طبيعي غير أنه سوف تجد صعوبه في استخدام بعض مزايا البرنامج صورة توضيحية: 2. بعد تفعيل الماكرو يغلق برنامج الاكسيل ويفتح مره اخرى علي صفحة حماية البرنامج ويتم فيها ادخال كلمة السر المدرجة مع .ملف البرنامج صورة توضيحية: 3. بعد كتابة كلمة السر والدخول علي البرنامج بتظهر الصفحة الرئيسية اللي بتتكون من عده أقسام 1. الأصناف والكميات 2. حركة المخزن 3. المبيعات (فواتير المبيعات بعد ادخالها) 4. كتابة الفواتير 5. الخروج من البرنامج شرح الأقسام القسم الأول: الأصناف والكميات: يتضمن هذا القسم الأصناف حيث يتم تكويد الصنف ووضع اسم الصنف في الخانة التالية ليه وسعر بيع الصنف وباقي الصفحة يعمل اتوماتيك مع عمليات الادخال التي تقوم بها صورة توضيحية: *** نجد في الاعلي ازارا التنقل داخل البرنامج احصائيات حول الاصناف كمية الأصناف من كمية الوارد والمنصرف داخل المخزن تنبيه: هناك فلتر علي الصنف واسم الصنف حتي نتمكن من تحديد صنف معين ومعرفة الوارد والمنصرف من ذلك الصنف وكلمة سر فك الضغط هي f7men Stores_Management_V3.1-برنامج_اكسيل_إدارة_المخازن_الإصدار_3.1.rar

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

السلام عليكم تواصل معي أخي الفاضل "وجيه شرف الدين" علي الخاص ليخبرني أن الملف به أخطاء وقد صححتها كما أرجو وأحببت أن أضيف الملف بعد التعديل حتي يستفيد منه كل من عنده نفس المسألة فقد غيرت الكود وأضفت عليه بعض الشروحات داخل الكود ليكون دليل لمن يحب التغيير أو التعديل عليه ضبط-كود-توزيع_2.xlsm

االبرنامج رائع وتصميمه جميل استمر في ابداعك ربنا يوفقك

اليكم الدرس السادس لشرح الاكسيل بعد اعادة التحميل https://youtu.be/D6jU0UGZGV0 وملف الشرح بالمرفقات اليكم الدرس السابع لتعليم الاكسيل https://youtu.be/PkI68grx4IU وملف الشرح من المرفقات الدرس السابع.xlsx

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

كيف يمكن تعبئة جدول مرتيب ابجديا فقط من خلال الكتابة في الصف رقم 2 للمزيد انظر الى هذا الملف WRITE_JUST IN ROW_2.xlsm

بارك الله فيك استاذ عبد اللطيف وزادك الله من فضله

أحسنت استاذ منير جزاك الله كل خير

أستاذ CFAMURAD أين الضغط على الإعجاب ؟!!💙

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

عمل ممتاز بارك الله فيك ووفقك الله دائما

اصبر استاذ منير أحسنت عمل رائع بارك الله فيك

الاخ / @waheidi اعتقد انه يوجد اكثر من طريقة لعمل ذلك ولكن اليك احدى هذه الطرق وبنفس الطريقة السابقة ـ انظر المرفق طبعا بدون البحث عن اسم الطالب ـ ولاحظ اضافة زر التحديث غياب_الطلاب.mdb

وعليكم السلام-يمكنك الإستعانة بهذا Trasted Location .. إنشاء موقع أمان لملفات الأكسيس توماتيكى

يمكنك هذا من خلال متابعتك لهذا الفيديو الجزء الأول عمل فورم الادخال في اكسل بتفاصيل رائعة مع الاستاذ الرائع اسلام رجب

هذا تعدل بسيط على طريقة الأستاذ @صلاح جبر zxc (1).accdb

السلام عليكم ورحمة الله وبركاته الاستعلام يُعتبر العمود الفقري لقواعد البيانات ، وكلما زادت معرفتنا به ، كلما يصبح البرنامج افضل واسرع 🙂 البحث/التصفية في الاستعلام من الطرق المهمة ، ولكن وللأسف الشديد ، ارى الكثير من المبرمجين لا يعرفون الطريقة الصحيحة في عملها ، فالطريقة الغير صحيحة قد تعطيك النتائج ولكن على حساب وقت تنفيذ الاستعلام 😞 الامثله هنا تقوم على انه يوجد لدينا نموذج اسمه frm_Main ، وبه حقل الاسم fName ، وحقل التاريخ:من Date_From ، وحقل التاريخ:الى Date_To ، والحقول في الاستعلام ، حقل الاسم fName ، وحقل التاريخ DateX . 1. اذا اردنا البحث عن اسم كامل (وليس جزء من اسم) ، فيجب ان يكون المعيار في الاستعلام: [forms]![frm_Main]![fName] 2. واذا كان حقل الاسم فارغا في النموذج ، ونريد ان نرى جميع الاسماء ، فالمعيار يصبح: iif(len([forms]![frm_Main]![fName] & '')=0,[fName],[forms]![frm_Main]![fName]) والشرح للتأكد بأن الحقل فارغ في النموذج، بدل ان نكتب IsNull([forms]![frm_Main]![fName]) or [forms]![frm_Main]![fName]=0 فإننا نختصر هذين الشرطين بشرط واحد len([forms]![frm_Main]![fName] & '')=0 iif(كان الحقل فارغ في النموذج,[fName] اعطنا جميع بيانات الحقل,[forms]![frm_Main]![fName]واذا كان الحقل به قيمة فاستعمل هذه القيمة) . 3. اذا اردنا البحث عن جزء من الاسم Like IIf(Len([forms]![frm_Main]![fName] & '')=0,"*","*" & [forms]![frm_Main]![fName] & "*") والشرح IIf(Len([forms]![frm_Main]![fName] & '')=0 نعم Like "*" لا Like "*" & [forms]![frm_Main]![fName] & "*") . 4. اذا اردنا البحث بين تاريخين بدون سجلات التاريخ الفارغة Between (IIf(Len([Forms]![frm_main]![Date_From] & '')=0,#01-Jan-1900#,[Forms]![frm_main]![Date_From])) And (IIf(Len([Forms]![frm_main]![Date_To] & '')=0,#01-Jan-2900#,[Forms]![frm_main]![Date_To])) والشرح Between (IIf(Len([Forms]![frm_main]![Date_From] & '')=0,#01-Jan-1900#,[Forms]![frm_main]![Date_From])) And (IIf(Len([Forms]![frm_main]![Date_To] & '')=0,#01-Jan-2900#,[Forms]![frm_main]![Date_To])) مع سجلات التاريخ الفارغة Between (IIf(Len([Forms]![frm_main]![Date_From] & '')=0,#01-Jan-1900#,[Forms]![frm_main]![Date_From])) And (IIf(Len([Forms]![frm_main]![Date_To] & '')=0,#01-Jan-2900#,[Forms]![frm_main]![Date_To])) Or [DateX] Is Null والشرح Between (IIf(Len([Forms]![frm_main]![Date_From] & '')=0,#01-Jan-1900#,[Forms]![frm_main]![Date_From])) And (IIf(Len([Forms]![frm_main]![Date_To] & '')=0,#01-Jan-2900#,[Forms]![frm_main]![Date_To])) Or [DateX] Is Null او طريقة استاذنا واخونا العود ابو خليل Between nz([forms]![frm_main]![Date_From];"01/01/1900") And nz([forms]![frm_main]![Date_To];"01/01/2100") . جعفر

السلام عليكم تحياتي أستاذ / zoed2 مرفق تجربة أحد أعضاء المحترمين وجدتها لدي للتعامل مع الصور من خلال الأسكنر أرجو أن تكون هو ما تطلبه مثال للتعامل مع الصور.mdb

جرب كود رمهان وهكذا الشهر (Month ) ID = "S" & Replace(Nz(DMax("id", "tbl1", "id like 's" & Right(Month(Date), 2) & "*'"), "s" & Right(Month(Date), 2) & "00000"), "s", "") + 1

بارك الله فيك أستاذى وجزيت خيرا جربت ولم يضبط معى

وأخيرا وهذا هو التعديل النهائى كما تريد ذر منفرد لإخفاء الصفوف واخر لإخفاء الأعمدة والأخير لإظهار الأعمدة والصفوف معا تقبل تحياتى جزاك الله خيرا وبارك الله فيك اخفاء الصفوف والأعمدة ثم إظهارها.xlsm

ممكن تجرب هذا time.xlsm

السلام عليكم ورحمة الله وبركاته الآن سنقوم بشرح الطريقة الجديدة لاضافة شريط ادوات باستخدام لغة التوصيف XML اولا: نقوم باضافة جدول نظام جديد: ننشئ جدول فى عرض التصميم وتكون حقوله كالآتى Field Name Type Field Size ID AutoNumber Long Integer RibbonName Text 255 RibbonXml Memo ونسميه USysRibbons ونحفظه نلاحظ اختفاء الجدول وذلك لان الجداول التى تبدأ ب USys او يعتبرها الاكسس من جداول النظام نفتح الجدول فى طريقة عرض Data Sheet ونضيف اول Tool Bar نضيف اسم الشريط ثم كود XML وهذا ما سنشرحه فى مشاركة قادمة ان شاء الله

الملف مرة تانية بالمرفقات ودا الكود المتسخدم بالشرح On Error Resume Next If Range("a3") = "" Or Range("b3") = "" Or Range("c3") = "" Then MsgBox "bla bla1", vbDefaultButton1, "bla bla1 " Else azsh = Sheet2.Range("c50000").End(xlUp).Row + 1 Sheet1.Range("A3:C3").Copy Sheet2.Cells(azsh, 1).PasteSpecial Paste:=xlPasteValues MsgBox "bla bla2", vbDefaultButton1, "bla bla2 " Sheet1.Range("A3:C3") = "" End If كود ترحيل البيانات- أوفيسنا.rar

السلام عليكم أخي الحبيب / بوعلام أولا إسمح لي فقد حذفت النسخة الأخري من الموضوع ، حيث انك وضعتها بالخطأ كما يحدث لنا جميعا ثانيا تفضل هذا الكود Sub t_booking() Dim sh As Worksheet Sheets("مواقيت الأساتدة").Activate last_row = [B10000].End(xlUp).Row Set sh = Sheets("حجز مواقيت الأقسام") last_row2 = sh.[D10000].End(xlUp).Row For rr = 8 To last_row If Cells(rr, 2) = "" Then GoTo 10 t_name = Cells(rr, 2) For day_col = 6 To 14 Step 2 For j = 8 To last_row2 If sh.Cells(j, day_col) = t_name Then t_time2 = sh.Cells(j, 4) t_deprt = sh.Cells(8 * Int(j / 8), 2) & " -- " & sh.Cells(j, 5) new_col = day_col / 2 + 2 For i = 0 To 7 t_time = Cells(rr + i, 4) If t_time = t_time2 Then Cells(rr + i, new_col) = t_deprt Next i End If Next j Next day_col 10 Next rr End Sub وهذا المرفق ، إضغط الزر الأزرق "مواقيت الأساتدة" المواقيت.rar