ابو جودي

السلام عليكم ورحمة الله تعالى وبركاته اساتذتى الكرام صباح الخيرات حالوت التعديل على قاعدة البيانات المرفقة حتى تعمل على كل من النواتين 32 , 64 ولكن حدثت مشكلة فى السطر الاتى lpPrevWndProc = apiSetWindowLong(hwnd, GWL_WNDPROC, AddressOf fWndProcTray) وبالأخص فى تلك الجزئية من السطر AddressOf fWndProcTray هل هناك حل لذلك القاعدة المرفقة هى القاعدة الأصلية تحسبا ان كان هناك خطأ منى عند محاولة تحويل الاكواد هل اجد من يتصدق على بتحويل القاعدة وحل المشكلة جزاكم الله خيرا لم اقوم بوضع مشاركتى الا بعد عناء طويل مرير من البحث Utilities Hide Ico Minimze To SysTray V.02.zip

رائع جدا استاذى القدير ومعلمى الجليل ما شاء الله

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

لا تحتاج الى عمل وحدة نمطية اكثر من مرة ولا تحتاج الى تكرار الاكواد بدون داعى فقط لابد من إزالة Exit Function وموقعها في الكود بين الروتين الذى يتم تطبيقه على النماذج والروتين الذى يتم تطبيقه على التقارير ولم يتم تغيير الخط فقط في التقارير بسبب الخروج من الروتين بسبب هذا السطر والأفضل من استخدام On Error Resume Next استخدام كود تصيد الأخطاء ErrorHandler لتتمكن من الوقوف على سبب ومكان وتوصيف ورقم الخطأ وتمت التعديلات كالاتي إزالة Exit Function تغيير اسم الروتين العام حتى يتناسب مع الوظيفة التي يقوم بها ليسهل مستقبلا لأى مطور التعامل بسهولة في قاعدة البيانات إضافة كود تصيد الأخطاء ErrorHandler للوقوف على سبب ومكان وتوصيف ورقم الأخطاء حتى يسهل تفاديها إن وجدت أخطاء إضاقة متغير ثابت في أول الكود ليتم وضع اسم الخط فقط مرة واحدة في الروتين من باب المرونة والتسهيل على المطور ملاحظة هامة جدا جدا لابد من تغير اسم الخط الذى قمت انا باستخدامه في الوحدة النمطية وهو Calibri (Detail) باسم الخط الذى تريد أنت التغيير إليه وقمت بوضع هذا التلميح للتذكير في الوحدة النمطية عند المتغير الثابت الذى يحمل اسم الخط <<---------< Font name must be changed here between the quotation marks يتم استدعاء الكود من خلالChange Font.mdb Call ApplyDefaultFont وأخيرا الروتين والذى يتم وضعه داخل وحدة نمطية Function ApplyDefaultFont() On Error GoTo ErrorHandler Const strFontName = "Calibri (Detail)" ' <<---------< Font name must be changed here between the quotation marks Dim frm As AccessObject Dim rpt As AccessObject Dim dbs As Object Dim frm1 As Access.Form Dim rpt1 As Access.Report Dim ctl As Access.Control Set dbs = Application.CurrentProject ' Apply Default Font for All Forms For Each frm In dbs.AllForms DoCmd.OpenForm frm.Name, acDesign Set frm1 = Forms(frm.Name) For Each ctl In frm1.Controls If ctl.ControlType = acComboBox Or _ ctl.ControlType = acCommandButton Or _ ctl.ControlType = acLabel Or _ ctl.ControlType = acListBox Or _ ctl.ControlType = acOptionButton Or _ ctl.ControlType = acTextBox Then ctl.FontName = strFontName 'Debug.Print frm.Name & " > " & ctl.ControlType & " > " & ctl.Name If frm1.DefaultView = 2 Then frm1.DatasheetFontName = strFontName End If End If Next ctl DoCmd.Close acForm, frm.Name, acSaveYes Next frm ' Apply Default Font for All Reports For Each rpt In dbs.AllReports DoCmd.OpenReport rpt.Name, acDesign Set rpt1 = Reports(rpt.Name) For Each ctl In rpt1.Controls If ctl.ControlType = acComboBox Or _ ctl.ControlType = acCommandButton Or _ ctl.ControlType = acLabel Or _ ctl.ControlType = acListBox Or _ ctl.ControlType = acOptionButton Or _ ctl.ControlType = acTextBox Then ctl.FontName = strFontName 'Debug.Print rpt.Name & " > " & ctl.ControlType & " > " & ctl.Name If rpt1.DefaultView = 2 Then frm1.DatasheetFontName = strFontName End If End If Next ctl DoCmd.Close acReport, rpt.Name, acSaveYes Next rpt Set frm = Nothing Set rpt = Nothing Set dbs = Nothing Set frm1 = Nothing Set rpt1 = Nothing Set ctl = Nothing Exit Function ExitHandler: Exit Function ErrorHandler: MsgBox "Error Number : " & Err.Number & vbNewLine & "Error Description : " & Err.Description End Function وهذا مرفق التطبيق لتعم الفائدة ويكون مرجعا سهلا ان شاء الله Change Font.mdb

طيب مبدئيا انا قمت بعمل بعض التعديلات الطفيفة جدا على الكود لأنه كان يتوقف بعد تغيير خطوط النماذج بسبب Exit Function قمت بإزالتها قمت بتغيير اسم الروتين العام حتى يتناسب مع الوظيفة ليسهل مستقبلا لأى احد معرفتها إضافة كود تصيد الأخطاء لمعرفة التوصيف والرقم المناسب لأى خطأ حتى يسهل تفاديه إضاقة متغير ثابت في اول الكود ليتم وضع اسم الخط فقط مرة واحدة ملاحظة هامة جدا جدا لابد من تغير اسم الخط الذى قمت انا باستخدامه في الوحدة النمطية وهو Calibri (Detail) باسم الخط الذى تريد أنت التغيير إليه وقمت بوضع هذا التلميح للتذكير في الوحدة النمطية عند المتغير الثابت الذى يحمل اسم الخط <<---------< Font name must be changed here between the quotation marks يتم استدعاء الكود من خلال Call ApplyDefaultFont ويتم وضع الكود الاتي في موديول Function ApplyDefaultFont() On Error GoTo ErrorHandler Const strFontName = "Calibri (Detail)" ' <<---------< Font name must be changed here between the quotation marks Dim frm As AccessObject Dim rpt As AccessObject Dim dbs As Object Dim frm1 As Access.Form Dim rpt1 As Access.Report Dim ctl As Access.Control Set dbs = Application.CurrentProject ' Apply Default Font for All Forms For Each frm In dbs.AllForms DoCmd.OpenForm frm.Name, acDesign Set frm1 = Forms(frm.Name) For Each ctl In frm1.Controls If ctl.ControlType = acComboBox Or _ ctl.ControlType = acCommandButton Or _ ctl.ControlType = acLabel Or _ ctl.ControlType = acListBox Or _ ctl.ControlType = acOptionButton Or _ ctl.ControlType = acTextBox Then ctl.FontName = strFontName 'Debug.Print frm.Name & " > " & ctl.ControlType & " > " & ctl.Name If frm1.DefaultView = 2 Then frm1.DatasheetFontName = strFontName End If End If Next ctl DoCmd.Close acForm, frm.Name, acSaveYes Next frm ' Apply Default Font for All Reports For Each rpt In dbs.AllReports DoCmd.OpenReport rpt.Name, acDesign Set rpt1 = Reports(rpt.Name) For Each ctl In rpt1.Controls If ctl.ControlType = acComboBox Or _ ctl.ControlType = acCommandButton Or _ ctl.ControlType = acLabel Or _ ctl.ControlType = acListBox Or _ ctl.ControlType = acOptionButton Or _ ctl.ControlType = acTextBox Then ctl.FontName = strFontName 'Debug.Print rpt.Name & " > " & ctl.ControlType & " > " & ctl.Name If rpt1.DefaultView = 2 Then frm1.DatasheetFontName = strFontName End If End If Next ctl DoCmd.Close acReport, rpt.Name, acSaveYes Next rpt Set frm = Nothing Set rpt = Nothing Set dbs = Nothing Set frm1 = Nothing Set rpt1 = Nothing Set ctl = Nothing Exit Function ExitHandler: Exit Function ErrorHandler: MsgBox "Error Number : " & Err.Number & vbNewLine & "Error Description : " & Err.Description End Function وهذا التطبيق العملي Change Font.mdb

اهلا اهلا اهلا اهلا أخي الحبيب وأستاذي الجليل يعلم الله اشتاقت نفسى الى لقياكم فإني احبكم في الله اسال الله تعالى ان يجمعني وإياكم على خيـر دئما أستاذي الجليل.. اعتذر ان تأخرت عليكم في الرد أستاذي ولكن العتب على النظر سامحني

ما شاء الله ... الله اكبر يحتاج الكثيرون اليه فعلا في تطبيقاتهم جزاكم الله خير ولكن لي تعقيب ان سمحت لي المكتبة التي تريد اضافتها يختلف الرقم بها تبعا للإصدار الاوفيس لدى كل شخص يعنى لن يكون الرقم 14 عند الجميع الأوفيس 2007 = 12 الأوفيس 2010 = 14 الأوفيس 2013 = 15 الأوفيس 2016 = 16 الأوفيس 2019 = 16 وللأسف أنا الان أعمل على الإصدار 2010 نسخة 32 بت والمكتبة غير موجودة ... قد تكون المشكلة من عندي انا.... الله اعلم والـ Ribbon Name لم يظهر في الاعدادات لا اعرف هل عدم وجود المكتبة السبب ام انا أخطأت في إحدى خطوات التنفيذ... على كل حال غدا ان شاء الله أقوم بالتجربة على جهاز أخر وأوافيكم بالنتيجة كل الشـر والتقدير والامتنان على هذه الهدية القيمة ..تقبل مودتي وارق أمنياتي بالنجاح والتوفيق يا باش مهندس تم الاشتراك في قناة اليوتيوب وهذا مرفق تجربتي تجربـــــة.accdb

انا نفسي اساعد حضرتك يا دكتور بس لازم افهم التصميم وخطوات العمل وترتيب تلك الخطوات بناء على ذلك أقوم بالتفكير ووضع التصورات اللازمة للوصول للنتيجة يعنى ببساطة مثل هذه المعادلة والتي هي أساس تفكيري ووضع التصورات اللازمة لإيجاد الحلول المناسبة معطى +مجهول = معلوم انا الان لا امتلك المعطيات اللازمة ولا عندي فكرة عن المعلومات الثابتة لذلك لن استطع الوصول لنتيجة المجهول

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

شكر الله لكم وزرقكم خير الدنيا والاخرة من وجهة نظرى المتواضعة والله اعلم على الترتيب C# فيجوال بيزك دوت نت ويلزم للتعامل معهما Sql

طيب يا دكتور ممكن مرفق من القاعدة الاصلية انا وضعت فكرتى حسب المرفق الموجود

انا مش فاهم قصد حضرتك بصراحة ممكن توضيح

مشاركة مع أساتذتي الكرام فكرتي المتواضعة امكانية التسجيل.accdb

وعليكم السلام ورحمة الله تعالى وبركاته العفو منكم أستاذي الجليل و ومعلمي القدير و والدى الحبيب أستاذ @jjafferr اذا حضر الماء بطل التيمم أستاذي وشتان بين الحلان فكرتي على طريقة الهواة أما طريقتكم هي طريقة المحترفون أستاذي انتم الحلو الذى الذى يزيل مرارة جهلنا والنور الذى ينير ظلمة جهلنا .. انتم سعادة الحياة بالنسبة لنا فسعادة الحياة أن تكون بجانبك وتساندك روح طيبة وكريمة تمنحك وتهديك الفرح والسرور وتدخل على نفوس من حولها الفرح و السعادة ولا أزكيكم على الله وكل اساتذتنا المبجلين كل كلمات ومعان الشكر والعرفان بالجميل لا تكفيكم وتوفيكم قدر حقكم أدامكم الله فوق رؤوسنا وملئ حياتكم سرورا وفرحا وبهجة ورزقكم من حيث لا تحتسبون أدامكم الله روح طيبة تسكن القلوب .. ووجه باسم ترتاح له العيون .. ونفس مطمئنة تمتلك النفوس .. بارك الله لكم في عمركم وفى علمكم و عملكم واهلكم وولدكم وأسال الله تعالى لكم سعادة الدارين وان يزيدكم من فضله كما تدخلون السرور على قلوب طلبة العلم دائما تكثرون من العطاء وبكل سخاء دون كلل ولا ملل ... احسن الله اليكم كما تحسنون الى طلاب العلم دائما اسأل الله لكم السعادة في الدارين والرزق و البركة في العمر والعلم والعمل والاهل والولد واسأله أن يغفر لكم ولوالديكم ومن تحبون وكل المسلمين ان شاء الله شكر الله لكم وجزاكم كل الخير ان شاء الله وأسأله عز وجل أن يعطيكم من عطــاياه ويمنحكم عفوه ورضاه ويغفر لكم من عمركم ما مضى ويقدر لكم الخير فيما أتى .. وأن يجعل السعادة رفيقتكم في الدنيا والآخرة.. اللهم آمين

وممكن على طريقة الاستاذ جعفر فى النموذج مباشرة بهذا الكود Me.cmb_3Dates.RowSourceType = "Value List" Me.cmb_3Dates.RowSource = Empty Dim Days As Integer For Days = 0 To 2 Me.cmb_3Dates.AddItem Format(DateAdd("d", Days, Date_Start), "dd/mm/yyyy") Next Days وان اردنا استعمالها من خلال روتين عام ممكن Function DayLoop2(ByVal DateStart As Date) As String Dim strSQL As String Dim i As Integer Dim N As Integer N = 2 strSQL = "" For i = 0 To 2 strSQL = strSQL & Format(DateAdd("d", i, DateStart), "dd/mm/yyyy") & "; " Next i DayLoop2 = strSQL End Function

وعليكم السلام ورحمة الله تعالى وبركاته أستاذي الجليل ومعلمي القدير و والدى الحبيب أستاذ @jjafferr اذا حضر الماء بطل التيمم

تعديل واضافة تم اضافة نوع البيانات من خلال الكود الاتى ... انظر النتيجة فى الاستعلام Public Function EnterType(fld) If CountCapitals(fld) > 0 Or CountSmall(fld) > 0 Then EnterType = "حروف انجليزية" If CountingArabic(fld) > 0 Then EnterType = "حروف عربية" If CountingNumbers(fld) > 0 Then EnterType = "ارقام" If CountingSpecialCharacter(fld) > 0 Then EnterType = "رموز" If CountCapitals(fld) > 0 Or CountSmall(fld) > 0 And CountingNumbers(fld) > 0 Then EnterType = "حروف انجليزية و ارقام" If CountingArabic(fld) > 0 And CountingNumbers(fld) > 0 Then EnterType = "حروف عربية و ارقام" End Function Database5 - 2.accdb

أولا : طهور إن شاء الله، أوصيكم بالصبر والثبات والإكثار من ذكر الله، أعظم الله أجركم، وضاعف مثوبتكم، شفاكم الله وعافاكم اللهم إني أسألك بأسمائك الحسنى وبصفاتك العلا وبرحمتك التي وسعت كلّ شيء، أن تمنّ علي أخونا عبد الله وعلى كل مريض بالشفاء العاجل، وألّا تدع فينا جرحًا إلّا داويته، ولا ألمًا إلا سكنته، ولا مرضًا إلا شفيته، وألبسنا ثوب الصحة والعافية عاجلًا غير آجل، وشافِنا وعافِنا واعف عنا، واشملنا بعطفك ومغفرتك، وتولّنا برحمتك يا أرحم الراحمين إلهي أذهب البأس ربّ النّاس، اشف وأنت الشّافي، لا شفاء إلا شفاؤك، شفاءً لا يغادر سقمًا، أذهب البأس ربّ النّاس، بيدك الشّفاء، لا كاشف له إلّا أنت يا رب العالمين ربنا الله الذي في السماء، تقدّس اسمك، أمرك في السماء والأرض، كما رحمتك في السماء، اجعل رحمتك في الأرض، اغفر لنا خطايانا، أنت رب الطيبين، أنزل رحمة من رحمتك، وشفاءً من شفائك على على كل مريض من أي وجع فيبرأ اللهم يا مُفرّج الكرب يا مُجيب دعوة المُضطرين، اللهم ألبس كل مريض ثوب الصحة والعافية عاجلًا غير آجل يا أرحم الراحمين، اللهم اشفى كل مريض ، اللهم اشفى كل مريض، اللهم اشفى كل مريض، اللهم آمين ----------------------- ثانيا : تتمحور فكرتي المتواضعة في هذه الاكواد والتي تكتب في موديول ويتم استدعائها حسب الحاجة انظر التطبيق داخل الاستعلام Public Function CountCapitals(fld) As Integer If fld & "" = "" Then Exit Function Dim StrLn As Integer CountCapitals = 0 For StrLn = 1 To Len(fld) Select Case Asc(Mid(fld, StrLn, 1)) Case 65 To 90: CountCapitals = CountCapitals + 1 End Select Next StrLn End Function Public Function CountSmall(fld) As Integer If fld & "" = "" Then Exit Function Dim StrLn As Integer CountSmall = 0 For StrLn = 1 To Len(fld) Select Case Asc(Mid(fld, StrLn, 1)) Case 97 To 122: CountSmall = CountSmall + 1 End Select Next StrLn End Function Public Function CountingNumbers(fld) As Integer If fld & "" = "" Then Exit Function Dim StrLn As Integer CountingNumbers = 0 For StrLn = 1 To Len(fld) Select Case Asc(Mid(fld, StrLn, 1)) Case 48 To 57: CountingNumbers = CountingNumbers + 1 End Select Next StrLn End Function Public Function CountingArabic(fld) As Integer If fld & "" = "" Then Exit Function Dim StrLn As Integer CountingArabic = 0 For StrLn = 1 To Len(fld) Select Case Asc(Mid(fld, StrLn, 1)) Case 192 To 214: CountingArabic = CountingArabic + 1 Case 216 To 219: CountingArabic = CountingArabic + 1 Case 221 To 223: CountingArabic = CountingArabic + 1 Case 225: CountingArabic = CountingArabic + 1 Case 227 To 230: CountingArabic = CountingArabic + 1 Case 236 To 237: CountingArabic = CountingArabic + 1 End Select Next StrLn End Function Public Function CountingSpecialCharacter(fld) As Integer If fld & "" = "" Then Exit Function Dim StrLn As Integer CountingSpecialCharacter = 0 For StrLn = 1 To Len(fld) Select Case Asc(Mid(fld, StrLn, 1)) Case 33 To 47: CountingSpecialCharacter = CountingSpecialCharacter + 1 Case 58 To 64: CountingSpecialCharacter = CountingSpecialCharacter + 1 Case 91 To 96: CountingSpecialCharacter = CountingSpecialCharacter + 1 Case 123 To 126: CountingSpecialCharacter = CountingSpecialCharacter + 1 End Select Next StrLn End Function Database5.accdb

اتفضل بدون اى جداول فقط حسب الوجدة النمطية 3Dates.accdb

ملاحظة الـ TabTip لا يعمل مع ويندوز 11

طيب الحمد لله

ممكن مرفق

ممكن المرفق من قاعدة البيانات ورجاء صور ال qrcode ذات امتداد png لماذا حضرتك ترفق صور بامتداد jpg

لابد من وجود Framework الاصدار 4

بكل صراحة لا اعرف ولكن لا ضير بان تضع مرفقا بكل كم البيانات ويا حبذا لو ترفق صورتين من ال qr code واحدة ممن يستطيع الماسح قراءتها وأخرى التي لا يستطيع الماسح قراءتها