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

وعليكم السلام-يمكنك استخدام هذه المعادلة لطلبك =EDATE($C5,$D5*12-$E5) test1.xlsx

جربي هذا الملف SUM_2.xlsm

وعليكم السلام-يمكنك استخدام هذه المعادلة =SUMIFS($B:$B,$A:$A,"<="&EOMONTH($D2,0),$A:$A,">="&$D2) 1SUM.xlsm

السلام عليكم 🙂 اذا عملنا برنامج على الاكسس 32بت ، وفيه مكتبات الوندوز الـ 32بت (لاحظ الرقم 32 في اسم المكتبة: comdlg32.dll) ، ثم شغلنا البرنامج على اكسس 64بت ، فنحصل على هذا الخطأ : . يوجد ملف في موقع مايكروسوف (مرفق نسخة Win32API_PtrSafe.zip) ، وفيه طريقة عمل مناداة النواتين : https://www.microsoft.com/en-us/download/details.aspx?id=9970 وتوجد مواقع مجهزة الكود للنواتين ، مثل (فقط ابحث عن الدالة ، واعمل نسخ/لصق للكود) : http://www.jkp-ads.com/articles/apideclarations.asp ------------------------------------------------------------------------------------------------------------------ ولكني هنا سأناقش كيف يمكننا تعديل المكتبة بدون الرجوع لهذه الروابط (للأسف ، سنضطر للرجوع لهذه الروابط لبعض المكتبات) !! والدوال التي استعملها هنا ، هي كأمثلة فقط ، والطريقة التي سنعمل بها هي ، ان نضع برنامج 32بت فيه الدالة ، ثم نفتح البرنامج بالاكسس 64بت ، ونبدأ نلاحق الاخطاء ونصلحها. وهناك 3 احتمالات فقط ، وسنناقشها جميعا ان شاء الله 🙂 الخطوة الاولى والاهم هي اضافة كلمة PtrSafe بعد كلمة Declare ، للنواتين 32بت و 64بت. أ. الدالة : Sleep نناديها بنواة 32بت هكذا : Private Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long) وهنا مثال لعملها : 1.Sleep.32bits.accdb.zip عندنا الطرق التالية (وجميعها تعمل وصحيحة) لنبدا العمل لجعل المكتبة تعمل على النواتين 32بت و64بت (وستكون طريقة عملنا بأحد هذه الطرق لجميع المكتبات) : نلاحظ ان الفرق بين كود 32بت (اعلاه) ، واول كود 64بت (ادناه) هو اضافة كلمة PtrSafe بعد كلمة Declare ، والتي يقبلها نظام 32بت كذلك ، وفي الطرق الثلاثة التالية ، نستخدم نفس الكود رقم 1 ، ولكننا نغلفه بالامر IF# ، ولهذا المثال ، سوف استخدم الطريقة رقم 3 : '1 'Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long) '2 '#If VBA7 Then ' Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long) '#Else ' Public Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long) '#End If '3 #If VBA7 And Win64 Then Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long) #Else Public Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long) #End If '4 '#If Win64 Then ' Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long) '#Else ' Public Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long) '#End If . ولكن ، لما نفتح الكود في الاكسس 64بت ، نلاحظ انه جعل كود 32بت باللون الاحمر : . على الرغم من البرنامج عمل لنا هذا السطر باللون الاحمر ، إلا ان الكود يعمل بطريقة صحيحة ، فلا تهتم به ، وبعد كل خطوة نعملها ، يجب ان نعمل Compile : حتى نعرف الخطأ التالي ، ونعدل عليه 🙂 ولما ما نحصل على خطأ ، فهنا نبدأ بتجربة البرنامج (على والاكسس 64بت ، والاكسس 32بت) ، حتى نتأكد بأنه يعمل بالطريقة الصحيحة ، والحمدلله ، هذه الدالة اصبحت جاهزة للعمل بالنواتين بهذا التغيير ، وتم تجربة الملف المرفق على النواتين🙂 وهذه النسخة بعد تحديثها للعمل على النواتين 32بت و64بت : 1.Sleep.64bits.accdb.zip ------------------------------------------------------------------------------------------------------ ب. الدوال: GetSystemDirectory ، GetWindowsDirectory ، GetTempDir نواة 32بت : Private Declare Function apiGetSystemDirectory& Lib "kernel32" _ Alias "GetSystemDirectoryA" _ (ByVal lpBuffer As String, ByVal nSize As Long) Private Declare Function apiGetWindowsDirectory& Lib "kernel32" _ Alias "GetWindowsDirectoryA" _ (ByVal lpBuffer As String, ByVal nSize As Long) Private Declare Function apiGetTempDir Lib "kernel32" _ Alias "GetTempPathA" (ByVal nBufferLength As Long, _ ByVal lpBuffer As String) As Long والبرنامج : 2.System_Directories.32bits.accdb.zip 64بت، خطوات التعديل ، بإضافة PtrSafe فقط: Private Declare PtrSafe Function apiGetSystemDirectory& Lib "kernel32" _ Alias "GetSystemDirectoryA" _ (ByVal lpBuffer As String, ByVal nSize As Long) Private Declare PtrSafe Function apiGetWindowsDirectory& Lib "kernel32" _ Alias "GetWindowsDirectoryA" _ (ByVal lpBuffer As String, ByVal nSize As Long) Private Declare PtrSafe Function apiGetTempDir Lib "kernel32" _ Alias "GetTempPathA" (ByVal nBufferLength As Long, _ ByVal lpBuffer As String) As Long وعمل البرنامج بشكل صحيح للنواتين : 2.System_Directories.64bits.accdb.zip ------------------------------------------------------------------------------------------------------ ج. الدالة: EnumFontFamilies عرض الخطوط fornts في مربع تحرير وسرد في الاكسس - قسم الأكسيس Access - أوفيسنا (officena.net) لأخونا @kanory 🙂 32بت : Private Declare Function EnumFontFamilies Lib "gdi32" Alias "EnumFontFamiliesA" (ByVal hdc As Long, ByVal lpszFamily As String, ByVal lpEnumFontFamProc As Long, lParam As Any) As Long Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Declare Function GetFocus Lib "user32" () As Long والبرنامج: 4.Kan_Fonts.32bits.accdb.zip 64بت، خطوات التعديل ، بإضافة PtrSafe فقط: Private Declare PtrSafe Function EnumFontFamilies Lib "gdi32" Alias "EnumFontFamiliesA" (ByVal hdc As Long, ByVal lpszFamily As String, ByVal lpEnumFontFamProc As Long, lParam As Any) As Long Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Declare PtrSafe Function GetFocus Lib "user32" () As Long - لما نعمل Compile نحصل على الخطأ في السطر التالي: . اذن الخطأ في المتغير الثالث من الدالة EnumFontFamilies ، والذي نوعه Long ، فيجب تغييره في الدالة الى LongPtr ، الخطوة الثانية تغيير النوع Long الى LongPtr في الدالة وطبعا اذا عملنا التغيير على السطر اعلاه، فالنواة 32بت ستعطيك خطأ هنا ، لذا يجب تغليف الدالة بالامر IF# ، هكذا : . وعند عمل Compile مرة اخرى ، لا نحصل على خطأ ، والبرنامج يعمل بطريقة صحيحة ، البرنامج يعمل بطريقة صحيحة : 4.Kan_Fonts.64bits.accdb.zip ------------------------------------------------------------------------------------------------------ د. دعوة لتجربة الاصدار الثالث من برنامج القران الكريم - صفحه 2 - قسم الأكسيس Access - أوفيسنا (officena.net) برنامج الذكر الحكيم لأخونا @ابا جودى 🙂 برنامج 32بت: 5.الذكر الحكيم V. 3.0.2.32bits.mdb.zip وقبل تشغيله على 64بت ، نضيف الامر PtrSafe الى جميع الدوال ، سواء لنواة 32بت او 64بت (ومنها تم عمله) ، ومنهم : Private Declare Sub ChooseColor Lib "msaccess.exe" Alias "#53" (ByVal hwnd As Long, clr As Long) '---color Picer الى Private Declare PtrSafe Sub ChooseColor Lib "msaccess.exe" Alias "#53" (ByVal hwnd As Long, clr As Long) '---color Picer والنتيجة تمام : 5.الذكر الحكيم V. 3.0.2.64bits.mdb.zip ------------------------------------------------------------------------------------------------------ هـ. عندما يعطي برنامج الاكسس اخطاء - النسخة رقم 3 - قسم الأكسيس Access - أوفيسنا (officena.net) مع ان الوحدة النمطية Shell_n_Wait تم اخذها من هذا الموقع : https://github.com/xxdoc/vb6-Shell-Wait/blob/master/Shell %26 Wait v2/modShellWait.bas والتي تم عملها للنواتين 32بت و64بت ، ولكن لايزال البرنامج يعطي اخطاء في بيئة 64بت ، فنفتحة في برنامج 64بت ، نضيف الامر PtrSafe الى جميع الدوال ، ونعمل Compile ، وجدنا خطأ ، ونلاحظ اننا ننادي الدالة MoveWindow والتي تعطي قيمتها الى المتغير retval : . والآن لنرى الدالة نفسها ، ولكن الدالة جاهزة من الاصل للنواة 64بت ، ولا تحتاج الى تعديل : . وبعد التمعن ، نرى ان الخطأ موجود في نوع المتغير retval ، حيث اننا اعلنا انه Long ، بينما في بيئة 64بت نلاحظ انه LongPtr ، فالحل يكون ، اما ان نعمل IF# في الكود الاول ، واما ان نوقف الاعلان في الكود الاول ، ونضيفه في الكود الثاني ، كل حسب نوعه ، وانا سأعمل المقترح الثاني: #If VBA7 Then Declare PtrSafe Function MoveWindow Lib "User32.dll" (ByVal HWnd As LongPtr, ByVal X As LongPtr, ByVal Y As LongPtr, ByVal nWidth As LongPtr, _ ByVal nHeight As LongPtr, ByVal bRepaint As LongPtr) As LongPtr Public retval As LongPtr #Else Declare Function MoveWindow Lib "User32.dll" (ByVal HWnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, _ ByVal nHeight As Long, ByVal bRepaint As Long) As Long Public retval As Long #End If . نعمل Compile مرة اخرى ، لنحصل على الخطأ التالي: . والدوال: . فالحل هو ان نغلف الدوال بالامر IF# ، ونجعل بيئة 64بت ان يكون LongPtr ، فقط للمتغير الاول لهذه الدالة ، . نعمل Compile مرة اخرى ، لنحصل على الخطأ التالي: . والتعديل : . وهكذا الى بقية الاخطاء المشابهة ..... الخطأ التالي ، والغير عن الاخطاء اعلاه : . بالبحث ، لا نجد له دالة ، وانما نجد انه تم الاعلان عنه: . فيجب حذفه من هذا الاعلان ، وإضافته الى التغليف IF# ، فيكون اعلاه للبيئة 32بت ، واما للنواة 64بت فيكون LongPtr ، وبعد جميع التعديلات ، تكون النسخة تعمل على النواتين ، كما في المرفق: عندما يعطي برنامج الاكسس اخطاء - النسخة رقم 4 + عمل نسخ احتياطية - قسم الأكسيس Access - أوفيسنا (officena.net) ------------------------------------------------------------------------------------------------------ واخيرا: و. دالة فتح نافذة اختيار/حفظ الملف: GetOpenFileName و GetSaveFileName والتعديل على هذه الدوال لا يعتمد على التغليف IF# ، وجعل الاعلان عن المتغير فيه ، ونما نحتاج الى تغيير Len الى LenB ، ونحتاج الى تعديل هذه الجزئية كذلك: . وهذا الملف للنواتين: 9.Allow_ByPass_Key.64bits.mdb.zip بهذه الطرق ، نستطيع ان نحول برامجنا لتعمل على نواتي اكسس 32بت و64بت 🙂 الموضوع فني بحت ، وتحتاج ان يكون عندك نواتي اكسس ، حتى تعدل على النواتين ، ثم تجربهم الاثنين 🙂 ------------------------------------------------------ وهناك طريقة ثانية ، اعتقد بأنها اسهل واستعملها دائما : جعفر 1.Sleep.64bits.accdb.zip 1.Sleep.32bits.accdb.zip Win32API_PtrSafe.zip

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

رائع استاذ حسين و لكن ما رأيك بهذا الكود (بدون أعمدة مساعدة) وحلقة تكرارية واحدة Sub Find_sum() Dim i As Long, a, b Dim Dic As Object Dim sh As Worksheet Set sh = Sheets("sheet1") sh.Range("J2").CurrentRegion.ClearContents a = sh.Cells(Rows.Count, 1).End(3).Row Set Dic = CreateObject("Scripting.Dictionary") For i = 2 To a If IsDate(sh.Cells(i, 1)) Then Dic(Format(sh.Cells(i, 1), "mmm")) = _ Dic(Format(sh.Cells(i, 1), "mmm")) + Val(sh.Cells(i, 2)) End If Next i If Dic.Count Then sh.Range("J2").Resize(Dic.Count) = _ Application.Transpose(Dic.keys) sh.Range("k2").Resize(Dic.Count) = _ Application.Transpose(Dic.Items) End If Set Dic = Nothing End Sub

هل تعلم ، انك لما وتريد تعمل نسخة من سجل ، فكل اللي عليك عمله هو الضغط على القطعة هذه ، ثم بالكيبورد تعمل نسخ Ctrl+C . ثم تنقر على المربع اللي تحته (عليه علامة * ) ، ثم تلصق بازرار الكيبورد Ctrl+V ، فيتم نسخ السجل كاملا الى سجل جديد (اعمله لعدد السجلات التي تريدها) ، واذا اردت ان تحذف سجل ، فكذلك انقر على مربع السجل (او السجلات) ، ثم اضغط على زر الكيبورد Del لتحذفها (ستخرج لك رسالة لتأكيد العملية) 🙂 انت قلت في ملف الاكسل : بينما الطريقة اللي عملت لك البرنامج ، كل سجل تكتبه ، يتم حفظه مباشرة ! لهذا السبب قلت لك من البداية : اليك هذه الطريقة لنسخ السجل الذي انت عليه الى سجل جديد ، فقط انقر على الزر "انسخ" ، وسوف يعمل يكرر السجل Duplicate الذي انت عليه 🙂 جعفر 1311.9.DATA12.mdb.zip

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

طيب مبدئيا بلاش كلمة استاذ لى فما انا الا طالب علم معكم بالنسبه للزر الجديد ممكن تستخد انشاء الزر بالمالعج وسوف يتم ادراج مثل هذا الكود لانشاء فاتوره جديده Private Sub btnNew_Click() On Error GoTo Err_btnNew_Click DoCmd.GoToRecord , , acNewRec Exit_btnNew_Click: Exit Sub Err_btnNew_Click: MsgBox Err.Description Resume Exit_btnNew_Click End Sub بالنسبه لاخر تعديل قمت به وهو بادخال الحساب وهم عدد 11 سجل بجدول tbl_Pages فاذا قمت بكتابه فحقل العدد 2 سيقوم بادراج 22 سجل اى بضرب هذا العدد فى عدد سجلات tbl_Pages اى 2*11 هذه محاولاتى الضعيفه بجوار اساتذتى جزاهم الله خيرا DATA11(1).mdb

السلام عليكم ورحمة الله وبركاته🌹 هذا الاصدار شبهه الاخير ان شاء الله تقريبا من وجهة نظرى البسيطة والضئيلة واطرحه بين اياديكم للاطلاع والتجربة والرد بما ترونه مناسبا من تعديلات واضافات المميزات الاضافية امكانية وضع مجلد القارئ داخل مجلد الصوت بمسار القاعدة فقط والباقى على البرنامج ، ملاحظة يتم مسح اى مجلدات فارغة من مسار مجلد الصوت اليا كنا يتم اضافة اسم القارئ والرابط اليا الى الجدول دون تدخل من المستخدم الاصدار السابق كان لابد من ان تكون ملفات الصوت mp3 بفضل الله تم التحايل بالكود حتى يتم تشغيل ال wav يوجد مجلد منافع يتم إدراجه اليا بمجرد فتح القاعدة تجدون فيه برنامج تغيير اسماء ملفات الصوت للمصحف دفعة واحدة طبعا لابد من الحرص قبل اضافة المجلدات ان تكون اسماء الملفات الصوتية مثل المرفق السابق والمثال الموجود بالمرفق الحالي كما تم اضافة امكانية تعديل الوان التطبيق ارضاء لجميع الاذواق وبذلك اكون بفضل الله تعالي اضفت كل ما تم تناوله وطرحه فى الموضوع السابق استاذى الجليل ومعلمى القدير ووالدى الحبيب استاذ @ابوخليل يعلم الله لم انم منذ ردكم بان المرفق لا يعمل عند حضرتك تاكدت من الاكواد جميعا بالسطر والكلمة والحرف اسال الله ان لا تواجه مشكلة هذه المرة لا يوجد كود بلا داع ولا توجد كلمات عربية داخل المحرر وتم التصميم على النواة ٣٢ بايت استاذى الجليل ومعلمى القدير الاستاذ @Gamal.Saad 🙏 لكم جزيل الشكر والعرفان بالجميل جزاكم الله خيرا 🌹 وضعت بهذا التطبيق عصارة ما لدى من افكار على طريقة كل من اساتذتى الافاضل الاجلاء الاستاذ @ابوخليل والاستاذ @jjafferr والاستاذ @رمهان وكل من تعلمت منهم وعلى ايديهم حتى لا اخطئ بنكران فضل لاحد فى هذا الصرح الرائع اتمنى ان شاء الله ان تنال رضاكم الذكر_الحكيم_V.__3.0.1.zip

اخي @ابا جودى وانا اعمل على موضوع تحويل البرامج 32بت الى 64بت ، هنا: تذكرت برنامجك الجميل ، وعملت فيه التعديل ، حتى يتسنى للجميع سماع صوت القرآن الكريم ، فشكرا لك 🙂 هذه النسخة تعمل على النواتين 32بت و 64بت 🙂 جعفر 2088803625_5.V.3.0.2.64bits.mdb.zip

أستاذ احمد الفلاحجي لك كل الحب و الاحترام

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

كنت اعتقد بأني عملت المطلوب !! انا عادة ما انسحب ، ولكني في هذه الحالة انسحب واترك المجال لغيري ، لعله يفهم طلبك ، ويساعدك !!

السلام عليكم مشاركة مع الاستاذ هاوى جزاه الله خيرا حاجه ع قد حالى m1Replace: Replace(Left([m1];Len([m1])-3);".";",") & "." & Right([m1];2) بالتوفيق

وعليكم السلام-تقريباً نفس الطلب استاذ أحمد ولذلك ليس هناك داعى لرفع مشاركة جديدة ومنفصلة .تم دمج واضافة المشاركة الجديدة هنا أيضاً ... أعتقد ان الموضوع ليس بالصعب , كان عليك تعلم وعمل ذلك بنفسك -تفضل =IFERROR(EDATE($E2,$D2*12-$F2),"") وتم أيضاً ضبط معادلة العمود D على ان تكون هكذا =IF(C2="","",IF(C2<=5,5,4)) test3.xlsx

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

استخدم دالة Replace مرتين ، مرة لإزالة "." والأخرى لتبيدل "," بـ "." Num = Replace(Num, ".", "") Num = Replace(Num, ",", ".") وتستطيع جمعهما في سطر واحد: Num = Replace(Replace(Num, ".", ""), ",", ".")

وعليكم السلام 🙂 هل استفدت من الروابط لربط الاكسس بقاعدة بيانات SQL server؟ جعفر

وعليكم السلام-بسيطة - تفضل =EDATE($C5,12-$D5) test2.xlsx

اذن منع التكرار أن تكون اللجنة والقاعة وليس التكرار في اللجنة فقط .... بمعنى : ان اللجنة 1 ..... القاعة1 ... لا يتكرران أم ان اللجنة1 لا يتكرر ليوم معين وكذلك القاعة ليوم معين مثلا يوم الاحد اللجنة1 لا يتكرر وايضا القاعة1

@ناقل جزاك الله خير المعطيات عندي بهذا الشكل

وهذا يعرض لك موقع التكرار If Not IsNull(DLookup("A", "ABCD", "A=form!A")) Then MsgBox "هذا الرقم تكرر عند " & DLookup("B", "ABCD", "A=form!A") End If

طبعا سؤالك حسب معطيات نموذجك ؟ ... لكن حاول ان تستفيد من هذا If DCount("الرقم", "Données _sur- les- élèves", "[الاسم] = '" & الاسم & "' And [اللقب] = '" & اللقب & "' And [رقم التسجيل] ='" & رقم_التسجيل & "'") > 0 Then Cancel = True MsgBox "هذا الشخص موجود", vbCritical, "عملية خاطئة" End If وهذه طريق اخرى If Not IsNull(DLookup("A", "ABCD", "A=form!A")) Then MsgBox "هذا الرقم تكرر عند " & DLookup("B", "ABCD", "A=form!A") End If

وعليكم السلام-استخدم هذه المعادلة ( معادلة مصفوفة) =IFERROR(INDEX(التسعير!$G$4:$J$1100,MATCH(1,IF(التسعير!$D$4:$D$1100=$E2, IF($F2>=التسعير!$E$4:$E$1100,IF($F2<=التسعير!$F$4:$F$1100,1))),0),MATCH($G2,التسعير!$G$3:$J$3,0)),"") 1المبيعات.xlsm

بعد اذن اساتذتي الكرام و لاثراء الموضوع كود بالحلقات التكرارية Sub test() Dim lr1, lr2 Dim x, x2 Dim tot tot = 0 Application.ScreenUpdating = False With Sheets("Sheet1") lr1 = .Cells(Rows.Count, 1).End(3).Row lr2 = .Cells(Rows.Count, "i").End(3).Row For x2 = 2 To lr2 For x = 2 To lr1 If Format(.Cells(x2, "i"), "mm-yyyy") = Format(.Cells(x, 1), "mm-yyyy") Then tot = tot + .Cells(x, 2) End If Next x .Cells(x2, "j") = tot tot = 0 Next x2 End With Application.ScreenUpdating = True End Sub SUM_2.xlsm

For Each Rng In Sh.Range("B6:U100") بدل For Each Rng In Sh.UsedRange

وعليكم السلام 🙂 هذا الرابط به مجموعة روابط لموضوعك : أكسس و اسكيوال سيرفر Access with Sql Server - قسم الأكسيس Access - أوفيسنا (officena.net) و جعفر

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

وعليكم السلام ورحمة الله وبركاته تم انشاء جدول tblWorkplace وربطه بجدول tbl_fbi وجدول tbl_User وتم وضع كود التحقق في النموذج If IsNull(Me.commu) Then MsgBox "فضلاً يجب أن تقوم بإدخال مكان العمل", vbInformation Me.user.SetFocus Exit Sub End If الصلاحيات المستخدمين (1).rar تحياتي

صحيح ما ذكرت معلمنا العزيز @jjafferr انه ذكر بعد الفرز ولكن النموذج والتقرير تم انشائهما عالجدول مباشرة وهو يريد فتح التقرير بعد التصفيه عالسجلات المصفاه فالامر تصفيه وليس فرز تحياتى معلمنا الغالى 💐

🙂 انت قلت : والآن تقول : جعفر

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

اضافة لمشاركة الاستاذ محمد طريقة اخرى اعمل المعيار مباشرة في امر فتح التقرير DoCmd.OpenReport "letter", acViewPreview, WhereCondition:="[zabon] like '" & [tt1] & "*'" letter.accdb

الطريقة عادية وبسيطة خاصة لمن تعامل مع الاصدار القديم وهي كالتالي : بعد انشاء الزر انقر بزر الفأرة الايمن واختر خصائص اختر لسان التبويب : حدث اختر اول حقل من الاحداث وهو حدث عند النقر وانقر على النقاط الثلاث والموجودة على يسار الحقل سيذهب بك الى محرر الاكواد وتجده كتب رأس الحدث ونهايته للطباعة الفوريةالصق هذه الجملة بين السطرين : DoCmd.OpenReport Me.Name, acViewNormal وان اردت اظهار مربع الطباعة قبل الطبع فالصق بدلا من ذلك هاتين الجملتين : DoCmd.OpenReport Me.Name, acViewPreview DoCmd.RunCommand acCmdPrint

السلام عليكم ورحمة الله وبركاته إخواني الكرام في المنتدى الأغر معكم في موضوع جديد وشيق ومفيد ، مع عالم الإكسيل ومع كل جديد ، ومع تنشيط لخلايا المخ اللي تخلي مخك حديد .. أقدم لكم المزيد والمزيد ، لعل الجميع يستفيد ، ويستضاء بنا ولو من بعيد (شكلي سرحت ..أعتذر عن المقدمة الطويلة يا أبو عيد) معنا اليوم فورم بسيط (فيه صندوق الدنيا (صندوق نص) TextBox وزر أمر Command Button) بالنسبة لصندوق النص غيرت فيه من الخصائص حاجتين اتنين وبس .. خاصية اسمها MultiLine ودي خليتها True ودي عشان تقدر سعادتك تكتب في أكتر من سطر والخاصية التانية EnterKeyBehavior ودي بردو True ودي عشان تقدر بعد ما تكتب سطر تضغط Enter يقوم ايه ؟؟ يقوم ينتقل للسطر اللي بعديه .. وهكذا وهكذا يعني تكتب كلمة البحث المراد البحث عنها وتضغط إنتر ، وتقدر تكتب كلمة تانية وتضغط إنتر ، وتقدر تكتب كلمة تالتة وتضغط إنتر ، وتقدر تكتب كلمة ( - - - - - ) كتبتها بالحبر السري عشان محدش ياخد باله وتضغط إنتر وهكذا وهكذا ولما تدوس على زر الأمر Search هتلاقي النتائج المراد البحث عنها تم تلوينها جرب مثلاً اكتب Yasser واضغط إنتر ، واكتب في السطر اللي بعديه "ياسر" من غير أقواس تنصيص واضغط إنتر ، وأخيراً دوووووس على زر الأمر وشوف النتائج ودا شكل الكود الموضوع في زر الأمر Private Sub CommandButton1_Click() Dim Cell As Range, Keys, Key, I As Long If Me.TextBox1.Value = "" Then Exit Sub Sheets("Sheet1").Cells(1).CurrentRegion.Font.ColorIndex = xlAutomatic Keys = Split(TextBox1.Value, vbCrLf) For Each Cell In Sheets("Sheet1").Cells(1).CurrentRegion.Columns(1).Cells For Each Key In Keys I = InStr(1, Cell.Value, Key) If I > 0 Then Cell.Characters(I, Len(Key)).Font.Color = vbRed End If Next Key Next Cell End Sub أرجو أن يكون الملف مفيد للجميع .. تقبلوا تحياتي وهكذا وهكذا Multiple Search & Color Results.rar

الطريقة لا تحتاج الى شرح فهذا الزر يتم عمله كما هو الحال في النماذج انتبه ! هذا الزر يظهر ويعمل في عرض التقرير ولكن لا يعمل في وضع المعاينة

السلام عليكم في 2010 يمكن وضع زر طباعة في التقرير نفسه ويختفي عند الطباعة وهذا غير موجود في 2003

السلام عليكم بناء على طلب الأخ Best سوف اشرح هذا الحل لأنه يوجد اكثر من حل . الحل هو 1+ 3 +6+0 = 10 ولكن كيف نوصل لهذا الحل يعني نفرق الأرقام كل رقم لوحده , طبعا الأمثلة القادمة بفرض انه الرقم 1360 موجود في الخلية A1 نعرف ان بإمكاننا نستخدم دالة MID لكي نستخلص اي قيمة من نص بعدد معين من موقع معين يعني MID(text,start_num,num_chars) =MID(A1,1,4) معناه استخلص من النص الموجود في الخلية A1 ابتداء من اول حرف وبعدد 4 حروف فالنتيجة حتكون 1360 =MID(A1,2,3) معناه استخلص من النص الموجود في الخلية A1 ابتداء من ثاني حرف وبعدد 3 حروف فالنتيجة حتكون 360 =MID(A1,3,1) معناه استخلص من النص الموجود في الخلية A1 ابتداء من ثالث حرف وبعدد 1 حروف فالنتيجة حتكون 6 بهذه الطريقة اقدر استخرج كل رقم لوحدة يعني =MID(A1,1,1) حتكون النتيجة 1 =MID(A1,2,1) حتكون النتيجة 3 =MID(A1,3,1) حتكون النتيجة 6 =MID(A1,4,1) حتكون النتيجة 0 يعني بكذا نكون نقدر نعرف كل رقم لوحده وممكن نكتب معادلة زي كده =MID(A1,1,1)+MID(A1,2,1)+MID(A1,3,1)+MID(A1,4,1) والنتيجة حتكون 1+ 3 +6+0 = 10 طبعا الحل هذا مش عملي مئة بالمئة لأنه ممكن تكون عندك خانات كثيرة وتغيرة الطول يعني مش دائما 4 خانات (المهم مش موضوعنا) نجي للحل الأحسن نلاحظ في المعادلة =MID(A1,1,1)+MID(A1,2,1)+MID(A1,3,1)+MID(A1,4,1) انه عبارة عن جمع معادلات متشابها ولكن يزيد في كل معادلة رقم يعني 1 في الأول وبعدين يصير 2 وبعدين يصير 3 وبعدين يصير 4 الى هو طول النص والى الدالة LEN تعطينا اياه . يعني الموضوع عبارة عن مجموع دالة واحدة بمتغير معروف الى هو من 1 الى طول النص(1360) يعني 1و2و3و4 ولو النص كان 78 كان نجتاج 1 و 2 ولو كان الرقم 13657 حنحتاج 1و2و3و4و5 حندخل في التعقيد انا الآن عرف اني محتاج مجموع الدالة mid لكن لازم بكذا قيمة يعني MID للحرف الأول وMID للحرف الثاني وMID للحرف الثالث ,MID للحرف الرابع يعني MID بمصفوفة قيم {1,2,3,4} ومادام مجموع ومصفوفة فحنفكر يا في SUMPRODUCT او في SUM ARRAY فخلينا في الأول احسن نحن نعرف انه الدالة SUMPRODUCT تأخد بيانات مصفوفة سواء خلايا او ارقام او معادلات يعني =SUMPRODUCT(B1:B3) حيعطيك مجموع القيم في B1,B2,B3 , =SUMPRODUCT({2,3,4}) حيعطيك اجمالي 2 +3 +4 =9 =SUMPRODUCT(B1+{2,3,4}) لو B1 فيها رقم 10 مثلا فحتكون النتيجة B1+2 + B1+3 + B1+4 يعني 2+10 + 3 +10 + 4+10 المجموع 39 طيب انا ممكن اقول =SUMPRODUCT(VALUE(MID(A1,{1,2,3,4},1))) كأننا نقول MID(A1,{1},1)+MID(A1,{2},1)+MID(A1,{3},1)+MID(A1,{4},1) يعني 1 +3 +6 +0 للمعلومية VALUE عشان النص يتحول لرقم ويمكن استخدام -- طيب جميل وصلنا لهذا الكود =SUMPRODUCT(VALUE(MID(A1,{1,2,3,4},1))) طيب هذي {1,2,3,4} ممكن اضع بدالها (ROW(1:4 رح تعطي نفس النتيجة , (ROW(1:6 تعطينا 1,2,3,4,5,6 وهكذا طيب مادام انا عارف طول النص بأستخدام الدالة LEN فممكن اضع (ROW(1:LEN(A1 ويعطينا( ROW(1:4 بفرض طول الرقم في الخلية اربع خانات بس الدالة ROW تأخد مرجع داخلها يعني (ROW(Referance عشان كده نستخدم الدالة INDIRECT تأخد نص وترجعه كمرجع (للمعلومية ممكن نستخدم Offset بدل Indirect ) يعني =ROW(INDIRECT("1:"&LEN(A1))) حتكون =ROW(INDIRECT("1:"&4)) حتكون =ROW(INDIRECT("1:4")) =ROW(1:4) حتكون {1,2,3,4} وتكون وصلنا للمطلوب فالتسلسل يصبح =SUMPRODUCT(--MID(A1,ROW(INDIRECT("1:" & LEN(A1))),1)) ال LEN حتعطينا 4لأنه طول النص 4 خانات =SUMPRODUCT(--MID(A1,ROW(INDIRECT("1:" & 4)),1)) =SUMPRODUCT(--MID(A1,ROW(INDIRECT("1:4")),1)) =SUMPRODUCT(--MID(A1,ROW(1:4),1)) الROW حتعطينا مصفوفة =SUMPRODUCT(--MID(A1,{1,2,3,4},1)) بفرض A1 قيمتها 1360 =SUMPRODUCT(--MID("1360",{1,2,3,4},1)) =SUMPRODUCT(--{"1","3","6","0"}) هنا علامة -- حتحول النص الى ارقام وممكن نستخدم الدالة VALUE بدل منها =SUMPRODUCT({1,3,6,0}) =10 أتمنى اكون وفقت في الشرح لأنه محرر النصوص حق المنتدى عقدني بصراحة تحياتي